Merge branch 'master' of git://git.haskell.org/ghc into GrowableAST

# Conflicts: # compiler/deSugar/DsArrows.hs # compiler/deSugar/DsBinds.hs # compiler/hsSyn/HsBinds.hs # compiler/hsSyn/HsDecls.hs # compiler/hsSyn/HsExpr.hs # compiler/hsSyn/HsLit.hs # compiler/hsSyn/HsPat.hs # compiler/typecheck/TcBinds.hs # compiler/typecheck/TcClassDcl.hs # compiler/typecheck/TcHsSyn.hs
author: Shayan Najd <sh.najd@gmail.com> 2017-08-13 18:37:54 +0000
committer: Shayan Najd <sh.najd@gmail.com> 2017-08-13 18:37:54 +0000
commit: 6752680ee9253aec991cfde4dc447479564e06e7 (patch)
tree: b4802e0583eeb0288123bfc53926ef68b124eabe
parent: 1c771765295bf789d4cda228a1f87c5a2e8e42b5 (diff)
parent: c6462ab02882779d7e33f2cac00cd89a9ac192f1 (diff)
download: haskell-6752680ee9253aec991cfde4dc447479564e06e7.tar.gz
343 files changed, 5780 insertions, 3767 deletions
diff --git a/.gitignore b/.gitignore
index 16071f62a6..f2d4be531e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -92,6 +92,7 @@ _darcs/
 /bindistprep/
 /bindisttest/HelloWorld
 /bindisttest/
+/bootstrapping/
 /ch01.html
 /ch02.html
 /compiler/dist/
@@ -171,6 +172,7 @@ _darcs/
 /rts/package.conf.install.raw
 /stage3.package.conf
 /testsuite_summary*.txt
+/testsuite*.xml
 /testlog*
 /utils/mkUserGuidePart/mkUserGuidePart.cabal
 /utils/runghc/runghc.cabal
diff --git a/.gitmodules b/.gitmodules
index 55d360ae10..9e0e8058be 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -70,14 +70,22 @@
 	path = libraries/filepath
 	url = ../packages/filepath.git
 	ignore = none
-[submodule "libraries/hoopl"]
-	path = libraries/hoopl
-	url = ../packages/hoopl.git
-	ignore = none
 [submodule "libraries/hpc"]
 	path = libraries/hpc
 	url = ../packages/hpc.git
 	ignore = none
+[submodule "libraries/parsec"]
+	path = libraries/parsec
+	url = ../packages/parsec.git
+	ignore = none
+[submodule "libraries/text"]
+	path = libraries/text
+	url = ../packages/text.git
+	ignore = none
+[submodule "libraries/mtl"]
+	path = libraries/mtl
+	url = ../packages/mtl.git
+	ignore = none
 [submodule "libraries/process"]
 	path = libraries/process
 	url = ../packages/process.git
diff --git a/Makefile b/Makefile
index 9b888e7cca..8046e36e14 100644
--- a/Makefile
+++ b/Makefile
@@ -129,9 +129,15 @@ endif
 	@echo "===--- building final phase"
 	$(MAKE) --no-print-directory -f ghc.mk phase=final $@
 
+# if BINARY_DIST_DIR is not set, assume we want the old
+# behaviour of placing the binary dist into the current
+# directory. Provide BINARY_DIST_DIR to put the final
+# binary distribution elsewhere.
+BINARY_DIST_DIR ?= .
+
 .PHONY: binary-dist
 binary-dist: binary-dist-prep
-	mv bindistprep/*.tar.$(TAR_COMP_EXT) .
+	mv bindistprep/*.tar.$(TAR_COMP_EXT) "$(BINARY_DIST_DIR)"
 
 .PHONY: binary-dist-prep
 binary-dist-prep:
diff --git a/aclocal.m4 b/aclocal.m4
index a9788bf5fb..11606c7842 100644
--- a/aclocal.m4
+++ b/aclocal.m4
@@ -2283,7 +2283,8 @@ AC_DEFUN([FIND_LD],[
       [enable_ld_override=yes])
 
     if test "x$enable_ld_override" = "xyes"; then
-        AC_CHECK_TARGET_TOOLS([TmpLd], [ld.gold ld.lld ld])
+        TmpLd="$LD" # In case the user set LD
+        AC_CHECK_TARGET_TOOLS([TmpLd], [ld.lld ld.gold ld])
 
         out=`$TmpLd --version`
         case $out in
diff --git a/compiler/backpack/RnModIface.hs b/compiler/backpack/RnModIface.hs
index 2e738c1ec6..e3da067ea4 100644
--- a/compiler/backpack/RnModIface.hs
+++ b/compiler/backpack/RnModIface.hs
@@ -646,6 +646,7 @@ rnIfaceCo (IfaceAppCo co1 co2)
     = IfaceAppCo <$> rnIfaceCo co1 <*> rnIfaceCo co2
 rnIfaceCo (IfaceForAllCo bndr co1 co2)
     = IfaceForAllCo <$> rnIfaceTvBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2
+rnIfaceCo (IfaceFreeCoVar c) = pure (IfaceFreeCoVar c)
 rnIfaceCo (IfaceCoVarCo lcl) = IfaceCoVarCo <$> pure lcl
 rnIfaceCo (IfaceAxiomInstCo n i cs)
     = IfaceAxiomInstCo <$> rnIfaceGlobal n <*> pure i <*> mapM rnIfaceCo cs
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 73bbf2cf57..fa8e0a846f 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -778,7 +778,7 @@ mkDataCon name declared_infix prom_info
 --      data T a where { MkT :: S }
 -- then it's possible that the univ_tvs may hit an assertion failure
 -- if you pull on univ_tvs.  This case is checked by checkValidDataCon,
--- so the error is detected properly... it's just that asaertions here
+-- so the error is detected properly... it's just that assertions here
 -- are a little dodgy.
 
   = con
@@ -902,7 +902,7 @@ dataConExTyVars (MkData { dcExTyVars = tvbs }) = binderVars tvbs
 dataConExTyVarBinders :: DataCon -> [TyVarBinder]
 dataConExTyVarBinders = dcExTyVars
 
--- | Both the universal and existentiatial type variables of the constructor
+-- | Both the universal and existential type variables of the constructor
 dataConAllTyVars :: DataCon -> [TyVar]
 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
   = binderVars (univ_tvs ++ ex_tvs)
diff --git a/compiler/basicTypes/Id.hs b/compiler/basicTypes/Id.hs
index 290e26291d..05290776d0 100644
--- a/compiler/basicTypes/Id.hs
+++ b/compiler/basicTypes/Id.hs
@@ -5,7 +5,7 @@
 \section[Id]{@Ids@: Value and constructor identifiers}
 -}
 
-{-# LANGUAGE ImplicitParams, CPP #-}
+{-# LANGUAGE CPP #-}
 
 -- |
 -- #name_types#
@@ -715,7 +715,7 @@ setIdCafInfo :: Id -> CafInfo -> Id
 setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
 
         ---------------------------------
-        -- Occcurrence INFO
+        -- Occurrence INFO
 idOccInfo :: Id -> OccInfo
 idOccInfo id = occInfo (idInfo id)
 
diff --git a/compiler/basicTypes/PatSyn.hs b/compiler/basicTypes/PatSyn.hs
index 0e218a39c1..d59810b5e1 100644
--- a/compiler/basicTypes/PatSyn.hs
+++ b/compiler/basicTypes/PatSyn.hs
@@ -63,7 +63,7 @@ data PatSyn
                                        -- record pat syn or same length as
                                        -- psArgs
 
-        -- Universially-quantified type variables
+        -- Universally-quantified type variables
         psUnivTyVars  :: [TyVarBinder],
 
         -- Required dictionaries (may mention psUnivTyVars)
@@ -76,7 +76,8 @@ data PatSyn
         psProvTheta   :: ThetaType,
 
         -- Result type
-        psOrigResTy   :: Type,         -- Mentions only psUnivTyVars
+        psResultTy   :: Type,  -- Mentions only psUnivTyVars
+                                -- See Note [Pattern synonym result type]
 
         -- See Note [Matchers and builders for pattern synonyms]
         psMatcher     :: (Id, Bool),
@@ -145,6 +146,43 @@ Example 3:
    You can see it's existential because it doesn't appear in the
    result type (T3 b).
 
+Note [Pattern synonym result type]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   data T a b = MkT b a
+
+   pattern P :: a -> T [a] Bool
+   pattern P x = MkT True [x]
+
+P's psResultTy is (T a Bool), and it really only matches values of
+type (T [a] Bool).  For example, this is ill-typed
+
+   f :: T p q -> String
+   f (P x) = "urk"
+
+This is differnet to the situation with GADTs:
+
+   data S a where
+     MkS :: Int -> S Bool
+
+Now MkS (and pattern synonyms coming from MkS) can match a
+value of type (S a), not just (S Bool); we get type refinement.
+
+That in turn means that if you have a pattern
+
+   P x :: T [ty] Bool
+
+it's not entirely straightforward to work out the instantiation of
+P's universal tyvars. You have to /match/
+  the type of the pattern, (T [ty] Bool)
+against
+  the psResultTy for the pattern synonym, T [a] Bool
+to get the instantiation a := ty.
+
+This is very unlike DataCons, where univ tyvars match 1-1 the
+arguments of the TyCon.
+
+
 Note [Pattern synonym representation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider the following pattern synonym declaration
@@ -174,7 +212,7 @@ In this case, the fields of MkPatSyn will be set as follows:
   psExTyVars   = [b]
   psProvTheta  = (Show (Maybe t), Ord b)
   psReqTheta   = (Eq t, Num t)
-  psOrigResTy  = T (Maybe t)
+  psResultTy  = T (Maybe t)
 
 Note [Matchers and builders for pattern synonyms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -325,7 +363,7 @@ mkPatSyn name declared_infix
                 psInfix = declared_infix,
                 psArgs = orig_args,
                 psArity = length orig_args,
-                psOrigResTy = orig_res_ty,
+                psResultTy = orig_res_ty,
                 psMatcher = matcher,
                 psBuilder = builder,
                 psFieldLabels = field_labels
@@ -368,7 +406,7 @@ patSynExTyVarBinders = psExTyVars
 patSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Type], Type)
 patSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs
                     , psProvTheta = prov, psReqTheta = req
-                    , psArgs = arg_tys, psOrigResTy = res_ty })
+                    , psArgs = arg_tys, psResultTy = res_ty })
   = (binderVars univ_tvs, req, binderVars ex_tvs, prov, arg_tys, res_ty)
 
 patSynMatcher :: PatSyn -> (Id,Bool)
@@ -405,9 +443,9 @@ patSynInstResTy :: PatSyn -> [Type] -> Type
 -- E.g.  pattern P x y = Just (x,x,y)
 --         P :: a -> b -> Just (a,a,b)
 --         (patSynInstResTy P [Int,Bool] = Maybe (Int,Int,Bool)
--- NB: unlikepatSynInstArgTys, the inst_tys should be just the *universal* tyvars
+-- NB: unlike patSynInstArgTys, the inst_tys should be just the *universal* tyvars
 patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
-                          , psOrigResTy = res_ty })
+                          , psResultTy = res_ty })
                 inst_tys
   = ASSERT2( univ_tvs `equalLength` inst_tys
            , text "patSynInstResTy" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
@@ -417,7 +455,7 @@ patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
 pprPatSynType :: PatSyn -> SDoc
 pprPatSynType (MkPatSyn { psUnivTyVars = univ_tvs,  psReqTheta  = req_theta
                         , psExTyVars   = ex_tvs,    psProvTheta = prov_theta
-                        , psArgs       = orig_args, psOrigResTy = orig_res_ty })
+                        , psArgs       = orig_args, psResultTy = orig_res_ty })
   = sep [ pprForAll univ_tvs
         , pprThetaArrowTy req_theta
         , ppWhen insert_empty_ctxt $ parens empty <+> darrow
diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs
index f71dac6273..1e6e7d2535 100644
--- a/compiler/basicTypes/SrcLoc.hs
+++ b/compiler/basicTypes/SrcLoc.hs
@@ -7,10 +7,6 @@
 {-# LANGUAGE DeriveTraversable  #-}
 {-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE RecordWildCards    #-}
-{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
-   -- Workaround for Trac #5252 crashes the bootstrap compiler without -O
-   -- When the earliest compiler we want to boostrap with is
-   -- GHC 7.2, we can make RealSrcLoc properly abstract
 
 -- | This module contains types that relate to the positions of things
 -- in source files, and allow tagging of those things with locations
diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs
index 87c4fe2240..9a39e2939b 100644
--- a/compiler/basicTypes/Var.hs
+++ b/compiler/basicTypes/Var.hs
@@ -64,6 +64,7 @@ module Var (
         TyVarBndr(..), ArgFlag(..), TyVarBinder,
         binderVar, binderVars, binderArgFlag, binderKind,
         isVisibleArgFlag, isInvisibleArgFlag, sameVis,
+        mkTyVarBinder, mkTyVarBinders,
 
         -- ** Constructing TyVar's
         mkTyVar, mkTcTyVar,
@@ -158,7 +159,7 @@ type TyCoVar = Id       -- Type, *or* coercion variable
 
 
 {- Many passes apply a substitution, and it's very handy to have type
-   synonyms to remind us whether or not the subsitution has been applied -}
+   synonyms to remind us whether or not the substitution has been applied -}
 
 type InVar      = Var
 type InTyVar    = TyVar
@@ -374,7 +375,7 @@ updateVarTypeM f id = do { ty' <- f (varType id)
 -- Is something required to appear in source Haskell ('Required'),
 -- permitted by request ('Specified') (visible type application), or
 -- prohibited entirely from appearing in source Haskell ('Inferred')?
--- See Note [TyBinders and ArgFlags] in TyCoRep
+-- See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility] in TyCoRep
 data ArgFlag = Required | Specified | Inferred
   deriving (Eq, Data)
 
@@ -429,6 +430,14 @@ binderArgFlag (TvBndr _ argf) = argf
 binderKind :: TyVarBndr TyVar argf -> Kind
 binderKind (TvBndr tv _) = tyVarKind tv
 
+-- | Make a named binder
+mkTyVarBinder :: ArgFlag -> Var -> TyVarBinder
+mkTyVarBinder vis var = TvBndr var vis
+
+-- | Make many named binders
+mkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]
+mkTyVarBinders vis = map (mkTyVarBinder vis)
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/cmm/CmmMonad.hs b/compiler/cmm/CmmMonad.hs
index fc66bf5928..c035577473 100644
--- a/compiler/cmm/CmmMonad.hs
+++ b/compiler/cmm/CmmMonad.hs
@@ -7,16 +7,13 @@
 -- The parser for C-- requires access to a lot more of the 'DynFlags',
 -- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.
 -----------------------------------------------------------------------------
-{-# LANGUAGE CPP #-}
 module CmmMonad (
     PD(..)
   , liftP
   ) where
 
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 
 import DynFlags
 import Lexer
@@ -34,10 +31,8 @@ instance Monad PD where
   (>>=) = thenPD
   fail = failPD
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail PD where
   fail = failPD
-#endif
 
 liftP :: P a -> PD a
 liftP (P f) = PD $ \_ s -> f s
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 3cb28217f2..78a186721b 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -2,9 +2,7 @@
 
 -- The default iteration limit is a bit too low for the definitions
 -- in this module.
-#if __GLASGOW_HASKELL__ >= 800
 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}
-#endif
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs
index 2be1020674..390a3173d7 100644
--- a/compiler/coreSyn/CoreLint.hs
+++ b/compiler/coreSyn/CoreLint.hs
@@ -64,10 +64,10 @@ import Demand ( splitStrictSig, isBotRes )
 import HscTypes
 import DynFlags
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 import MonadUtils
+import Data.Foldable      ( toList )
+import Data.List.NonEmpty ( NonEmpty )
 import Data.Maybe
 import Pair
 import qualified GHC.LanguageExtensions as LangExt
@@ -1949,10 +1949,8 @@ instance Monad LintM where
                            Just r -> unLintM (k r) env errs'
                            Nothing -> (Nothing, errs'))
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail LintM where
     fail err = failWithL (text err)
-#endif
 
 instance HasDynFlags LintM where
   getDynFlags = LintM (\ e errs -> (Just (le_dynflags e), errs))
@@ -2431,15 +2429,15 @@ pprLeftOrRight :: LeftOrRight -> MsgDoc
 pprLeftOrRight CLeft  = text "left"
 pprLeftOrRight CRight = text "right"
 
-dupVars :: [[Var]] -> MsgDoc
+dupVars :: [NonEmpty Var] -> MsgDoc
 dupVars vars
   = hang (text "Duplicate variables brought into scope")
-       2 (ppr vars)
+       2 (ppr (map toList vars))
 
-dupExtVars :: [[Name]] -> MsgDoc
+dupExtVars :: [NonEmpty Name] -> MsgDoc
 dupExtVars vars
   = hang (text "Duplicate top-level variables with the same qualified name")
-       2 (ppr vars)
+       2 (ppr (map toList vars))
 
 {-
 ************************************************************************
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index 28d35528fe..1ac3084e39 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -374,7 +374,7 @@ pprTypedLamBinder bind_site debug_on var
   = sdocWithDynFlags $ \dflags ->
     case () of
     _
-      | not debug_on            -- Show case-bound wild bilders only if debug is on
+      | not debug_on            -- Show case-bound wild binders only if debug is on
       , CaseBind <- bind_site
       , isDeadBinder var        -> empty
 
diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs
index a6b9db46cb..fcff256123 100644
--- a/compiler/coreSyn/TrieMap.hs
+++ b/compiler/coreSyn/TrieMap.hs
@@ -278,6 +278,9 @@ instance TrieMap m => TrieMap (ListMap m) where
    foldTM   = fdList
    mapTM    = mapList
 
+instance (TrieMap m, Outputable a) => Outputable (ListMap m a) where
+  ppr m = text "List elts" <+> ppr (foldTM (:) m [])
+
 mapList :: TrieMap m => (a->b) -> ListMap m a -> ListMap m b
 mapList f (LM { lm_nil = mnil, lm_cons = mcons })
   = LM { lm_nil = fmap f mnil, lm_cons = mapTM (mapTM f) mcons }
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index cb9837ed0c..ab2047fcf3 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -12,13 +12,16 @@ module Check (
         checkSingle, checkMatches, isAnyPmCheckEnabled,
 
         -- See Note [Type and Term Equality Propagation]
-        genCaseTmCs1, genCaseTmCs2
+        genCaseTmCs1, genCaseTmCs2,
+
+        -- Pattern-match-specific type operations
+        pmIsClosedType, pmTopNormaliseType_maybe
     ) where
 
 #include "HsVersions.h"
 
 import TmOracle
-
+import Unify( tcMatchTy )
 import BasicTypes
 import DynFlags
 import HsSyn
@@ -27,6 +30,7 @@ import Id
 import ConLike
 import Name
 import FamInstEnv
+import TysPrim (tYPETyCon)
 import TysWiredIn
 import TyCon
 import SrcLoc
@@ -42,9 +46,11 @@ import TcType        (toTcType, isStringTy, isIntTy, isWordTy)
 import Bag
 import ErrUtils
 import Var           (EvVar)
+import TyCoRep
 import Type
 import UniqSupply
 import DsGRHSs       (isTrueLHsExpr)
+import Maybes        ( expectJust )
 
 import Data.List     (find)
 import Data.Maybe    (isJust, fromMaybe)
@@ -372,7 +378,7 @@ checkMatches' vars matches
         (NotCovered, Diverged )   -> (final_prov,  rs, final_u, m:is)
 
     hsLMatchToLPats :: LMatch id body -> Located [LPat id]
-    hsLMatchToLPats (L l (Match _ pats _ _)) = L l pats
+    hsLMatchToLPats (L l (Match { m_pats = pats })) = L l pats
 
 -- | Check an empty case expression. Since there are no clauses to process, we
 --   only compute the uncovered set. See Note [Checking EmptyCase Expressions]
@@ -406,6 +412,147 @@ checkEmptyCase' var = do
             else PmResult FromBuiltin [] uncovered []
     Nothing -> return emptyPmResult
 
+-- | Returns 'True' if the argument 'Type' is a fully saturated application of
+-- a closed type constructor.
+--
+-- Closed type constructors are those with a fixed right hand side, as
+-- opposed to e.g. associated types. These are of particular interest for
+-- pattern-match coverage checking, because GHC can exhaustively consider all
+-- possible forms that values of a closed type can take on.
+--
+-- Note that this function is intended to be used to check types of value-level
+-- patterns, so as a consequence, the 'Type' supplied as an argument to this
+-- function should be of kind @Type@.
+pmIsClosedType :: Type -> Bool
+pmIsClosedType ty
+  = case splitTyConApp_maybe ty of
+      Just (tc, ty_args)
+             | is_algebraic_like tc && not (isFamilyTyCon tc)
+             -> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True
+      _other -> False
+  where
+    -- This returns True for TyCons which /act like/ algebraic types.
+    -- (See "Type#type_classification" for what an algebraic type is.)
+    --
+    -- This is qualified with \"like\" because of a particular special
+    -- case: TYPE (the underlyind kind behind Type, among others). TYPE
+    -- is conceptually a datatype (and thus algebraic), but in practice it is
+    -- a primitive builtin type, so we must check for it specially.
+    --
+    -- NB: it makes sense to think of TYPE as a closed type in a value-level,
+    -- pattern-matching context. However, at the kind level, TYPE is certainly
+    -- not closed! Since this function is specifically tailored towards pattern
+    -- matching, however, it's OK to label TYPE as closed.
+    is_algebraic_like :: TyCon -> Bool
+    is_algebraic_like tc = isAlgTyCon tc || tc == tYPETyCon
+
+pmTopNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Type, [DataCon], Type)
+-- ^ Get rid of *outermost* (or toplevel)
+--      * type function redex
+--      * data family redex
+--      * newtypes
+--
+-- Behaves exactly like `topNormaliseType_maybe`, but instead of returning a
+-- coercion, it returns useful information for issuing pattern matching
+-- warnings. See Note [Type normalisation for EmptyCase] for details.
+pmTopNormaliseType_maybe env typ
+  = do ((ty_f,tm_f), ty) <- topNormaliseTypeX stepper comb typ
+       return (eq_src_ty ty (typ : ty_f [ty]), tm_f [], ty)
+  where
+    -- Find the first type in the sequence of rewrites that is a data type,
+    -- newtype, or a data family application (not the representation tycon!).
+    -- This is the one that is equal (in source Haskell) to the initial type.
+    -- If none is found in the list, then all of them are type family
+    -- applications, so we simply return the last one, which is the *simplest*.
+    eq_src_ty :: Type -> [Type] -> Type
+    eq_src_ty ty tys = maybe ty id (find is_closed_or_data_family tys)
+
+    is_closed_or_data_family :: Type -> Bool
+    is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyAppType ty
+
+    -- For efficiency, represent both lists as difference lists.
+    -- comb performs the concatenation, for both lists.
+    comb (tyf1, tmf1) (tyf2, tmf2) = (tyf1 . tyf2, tmf1 . tmf2)
+
+    stepper = newTypeStepper `composeSteppers` tyFamStepper
+
+    -- A 'NormaliseStepper' that unwraps newtypes, careful not to fall into
+    -- a loop. If it would fall into a loop, it produces 'NS_Abort'.
+    newTypeStepper :: NormaliseStepper ([Type] -> [Type],[DataCon] -> [DataCon])
+    newTypeStepper rec_nts tc tys
+      | Just (ty', _co) <- instNewTyCon_maybe tc tys
+      = case checkRecTc rec_nts tc of
+          Just rec_nts' -> let tyf = ((TyConApp tc tys):)
+                               tmf = ((tyConSingleDataCon tc):)
+                           in  NS_Step rec_nts' ty' (tyf, tmf)
+          Nothing       -> NS_Abort
+      | otherwise
+      = NS_Done
+
+    tyFamStepper :: NormaliseStepper ([Type] -> [Type], [DataCon] -> [DataCon])
+    tyFamStepper rec_nts tc tys  -- Try to step a type/data family
+      = let (_args_co, ntys) = normaliseTcArgs env Representational tc tys in
+          -- NB: It's OK to use normaliseTcArgs here instead of
+          -- normalise_tc_args (which takes the LiftingContext described
+          -- in Note [Normalising types]) because the reduceTyFamApp below
+          -- works only at top level. We'll never recur in this function
+          -- after reducing the kind of a bound tyvar.
+
+        case reduceTyFamApp_maybe env Representational tc ntys of
+          Just (_co, rhs) -> NS_Step rec_nts rhs ((rhs:), id)
+          _               -> NS_Done
+
+{- Note [Type normalisation for EmptyCase]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+EmptyCase is an exception for pattern matching, since it is strict. This means
+that it boils down to checking whether the type of the scrutinee is inhabited.
+Function pmTopNormaliseType_maybe gets rid of the outermost type function/data
+family redex and newtypes, in search of an algebraic type constructor, which is
+easier to check for inhabitation.
+
+It returns 3 results instead of one, because there are 2 subtle points:
+1. Newtypes are isomorphic to the underlying type in core but not in the source
+   language,
+2. The representational data family tycon is used internally but should not be
+   shown to the user
+
+Hence, if pmTopNormaliseType_maybe env ty = Just (src_ty, dcs, core_ty), then
+  (a) src_ty is the rewritten type which we can show to the user. That is, the
+      type we get if we rewrite type families but not data families or
+      newtypes.
+  (b) dcs is the list of data constructors "skipped", every time we normalise a
+      newtype to it's core representation, we keep track of the source data
+      constructor.
+  (c) core_ty is the rewritten type. That is,
+        pmTopNormaliseType_maybe env ty = Just (src_ty, dcs, core_ty)
+      implies
+        topNormaliseType_maybe env ty = Just (co, core_ty)
+      for some coercion co.
+
+To see how all cases come into play, consider the following example:
+
+  data family T a :: *
+  data instance T Int = T1 | T2 Bool
+  -- Which gives rise to FC:
+  --   data T a
+  --   data R:TInt = T1 | T2 Bool
+  --   axiom ax_ti : T Int ~R R:TInt
+
+  newtype G1 = MkG1 (T Int)
+  newtype G2 = MkG2 G1
+
+  type instance F Int  = F Char
+  type instance F Char = G2
+
+In this case pmTopNormaliseType_maybe env (F Int) results in
+
+  Just (G2, [MkG2,MkG1], R:TInt)
+
+Which means that in source Haskell:
+  - G2 is equivalent to F Int (in contrast, G1 isn't).
+  - if (x : R:TInt) then (MkG2 (MkG1 x) : F Int).
+-}
+
 -- | Generate all inhabitation candidates for a given type. The result is
 -- either (Left ty), if the type cannot be reduced to a closed algebraic type
 -- (or if it's one trivially inhabited, like Int), or (Right candidates), if it
@@ -439,7 +586,8 @@ inhabitationCandidates fam_insts ty
             (_:_) -> do var <- liftD $ mkPmId (toTcType core_ty)
                         let va = build_tm (PmVar var) dcs
                         return $ Right [(va, mkIdEq var, emptyBag)]
-        | isClosedAlgType core_ty -> liftD $ do
+
+        | pmIsClosedType core_ty -> liftD $ do
             var  <- mkPmId (toTcType core_ty) -- it would be wrong to unify x
             alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc)
             return $ Right [(build_tm va dcs, eq, cs) | (va, eq, cs) <- alts]
@@ -747,7 +895,7 @@ translateConPatVec fam_insts  univ_tys  ex_tvs c (RecCon (HsRecFields fs _))
 -- Translate a single match
 translateMatch :: FamInstEnvs -> LMatch GhcTc (LHsExpr GhcTc)
                -> DsM (PatVec,[PatVec])
-translateMatch fam_insts (L _ (Match _ lpats _ grhss)) = do
+translateMatch fam_insts (L _ (Match { m_pats = lpats, m_grhss = grhss })) = do
   pats'   <- concat <$> translatePatVec fam_insts pats
   guards' <- mapM (translateGuards fam_insts) guards
   return (pats', guards')
@@ -971,14 +1119,14 @@ mkOneConFull :: Id -> ConLike -> DsM (ValAbs, ComplexEq, Bag EvVar)
 --          ComplexEq:       x ~ K y1..yn
 --          [EvVar]:         Q
 mkOneConFull x con = do
-  let -- res_ty == TyConApp (ConLikeTyCon cabs_con) cabs_arg_tys
-      res_ty  = idType x
-      (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, _)
+  let res_ty  = idType x
+      (univ_tvs, ex_tvs, eq_spec, thetas, _req_theta , arg_tys, con_res_ty)
         = conLikeFullSig con
-      tc_args = case splitTyConApp_maybe res_ty of
-                  Just (_, tys) -> tys
-                  Nothing -> pprPanic "mkOneConFull: Not TyConApp:" (ppr res_ty)
-      subst1  = zipTvSubst univ_tvs tc_args
+      tc_args = tyConAppArgs res_ty
+      subst1  = case con of
+                  RealDataCon {} -> zipTvSubst univ_tvs tc_args
+                  PatSynCon {}   -> expectJust "mkOneConFull" (tcMatchTy con_res_ty res_ty)
+                                    -- See Note [Pattern synonym result type] in PatSyn
 
   (subst, ex_tvs') <- cloneTyVarBndrs subst1 ex_tvs <$> getUniqueSupplyM
 
@@ -1740,9 +1888,9 @@ pp_context singular (DsMatchContext kind _loc) msg rest_of_msg_fun
 
     (ppr_match, pref)
         = case kind of
-             FunRhs (L _ fun) _ _ -> (pprMatchContext kind,
-                                      \ pp -> ppr fun <+> pp)
-             _                    -> (pprMatchContext kind, \ pp -> pp)
+             FunRhs { mc_fun = L _ fun }
+                  -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
+             _    -> (pprMatchContext kind, \ pp -> pp)
 
 ppr_pats :: HsMatchContext Name -> [Pat GhcTc] -> SDoc
 ppr_pats kind pats
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 16537bd7a5..a9d953dc0e 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -3,7 +3,7 @@
 (c) University of Glasgow, 2007
 -}
 
-{-# LANGUAGE CPP, NondecreasingIndentation, RecordWildCards #-}
+{-# LANGUAGE NondecreasingIndentation, RecordWildCards #-}
 
 module Coverage (addTicksToBinds, hpcInitCode) where
 
@@ -11,11 +11,7 @@ import qualified GHCi
 import GHCi.RemoteTypes
 import Data.Array
 import ByteCodeTypes
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
-#else
-import GHC.Stack as GHC.Stack.CCS
-#endif
 import Type
 import HsSyn
 import Module
@@ -281,31 +277,6 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
                       | ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
                       , isInlinePragma (idInlinePragma pid) ] }
 
-addTickLHsBind (L pos bind@(AbsBindsSig { abs_sig_bind   = val_bind
-                                        , abs_sig_export = poly_id }))
-  | L _ FunBind { fun_id = L _ mono_id } <- val_bind
-  = do withEnv (add_export  mono_id) $ do
-       withEnv (add_inlines mono_id) $ do
-       val_bind' <- addTickLHsBind val_bind
-       return $ L pos $ bind { abs_sig_bind = val_bind' }
-
-  | otherwise
-  = pprPanic "addTickLHsBind" (ppr bind)
- where
-  -- see AbsBinds comments
-  add_export mono_id env
-    | idName poly_id `elemNameSet` exports env
-    = env { exports = exports env `extendNameSet` idName mono_id }
-    | otherwise
-    = env
-
-  -- See Note [inline sccs]
-  add_inlines mono_id env
-    | isInlinePragma (idInlinePragma poly_id)
-    = env { inlines = inlines env `extendVarSet` mono_id }
-    | otherwise
-    = env
-
 addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id)  }))) = do
   let name = getOccString id
   decl_path <- getPathEntry
@@ -682,10 +653,10 @@ addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do
 
 addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
              -> TM (Match GhcTc (LHsExpr GhcTc))
-addTickMatch isOneOfMany isLambda (Match mf pats opSig gRHSs) =
+addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats, m_grhss = gRHSs }) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
-    return $ Match mf pats opSig gRHSs'
+    return $ match { m_grhss = gRHSs' }
 
 addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
              -> TM (GRHSs GhcTc (LHsExpr GhcTc))
@@ -923,10 +894,10 @@ addTickCmdMatchGroup mg@(MG { mg_alts = L l matches }) = do
   return $ mg { mg_alts = L l matches' }
 
 addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
-addTickCmdMatch (Match mf pats opSig gRHSs) =
+addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
   bindLocals (collectPatsBinders pats) $ do
     gRHSs' <- addTickCmdGRHSs gRHSs
-    return $ Match mf pats opSig gRHSs'
+    return $ match { m_grhss = gRHSs' }
 
 addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
 addTickCmdGRHSs (GRHSs guarded (L l local_binds)) = do
@@ -1304,7 +1275,7 @@ hpcSrcSpan = mkGeneralSrcSpan (fsLit "Haskell Program Coverage internals")
 matchesOneOfMany :: [LMatch GhcTc body] -> Bool
 matchesOneOfMany lmatches = sum (map matchCount lmatches) > 1
   where
-        matchCount (L _ (Match _ _pats _ty (GRHSs grhss _binds))) = length grhss
+        matchCount (L _ (Match { m_grhss = GRHSs grhss _binds })) = length grhss
 
 type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)
 
diff --git a/compiler/deSugar/DsArrows.hs b/compiler/deSugar/DsArrows.hs
index 97ec32de5c..c1633ee582 100644
--- a/compiler/deSugar/DsArrows.hs
+++ b/compiler/deSugar/DsArrows.hs
@@ -447,8 +447,8 @@ dsCmd ids local_vars stack_ty res_ty (HsCmdApp cmd arg) env_ids = do
 --              ---> premap (\ ((xs), (p1, ... (pk,stk)...)) -> ((ys),stk)) cmd
 
 dsCmd ids local_vars stack_ty res_ty
-        (HsCmdLam (MG { mg_alts = L _ [L _ (Match _ pats _
-                                           (GRHSs [L _ (GRHS [] body)] _ ))] }))
+        (HsCmdLam (MG { mg_alts = L _ [L _ (Match { m_pats  = pats
+                                                  , m_grhss = GRHSs [L _ (GRHS [] body)] _ })] }))
         env_ids = do
     let pat_vars = mkVarSet (collectPatsBinders pats)
     let
@@ -1106,7 +1106,7 @@ matchSimplys _ _ _ _ _ = panic "matchSimplys"
 
 leavesMatch :: LMatch GhcTc (Located (body (GHC GhcTc)))
             -> [(Located (body (GHC GhcTc)), IdSet)]
-leavesMatch (L _ (Match _ pats _ (GRHSs grhss (L _ binds))))
+leavesMatch (L _ (Match { m_pats = pats, m_grhss = GRHSs grhss (L _ binds) }))
   = let
         defined_vars = mkVarSet (collectPatsBinders pats)
                         `unionVarSet`
@@ -1125,11 +1125,11 @@ replaceLeavesMatch
         -> LMatch GhcTc (Located (body (GHC GhcTc)))  -- the matches of a case command
         -> ([Located (body' (GHC GhcTc))],            -- remaining leaf expressions
             LMatch GhcTc (Located (body' (GHC GhcTc)))) -- updated match
-replaceLeavesMatch _res_ty leaves (L loc (Match mf pat mt (GRHSs grhss binds)))
+replaceLeavesMatch _res_ty leaves (L loc match@(Match { m_grhss = GRHSs grhss binds }))
   = let
         (leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
     in
-    (leaves', L loc (Match mf pat mt (GRHSs grhss' binds)))
+    (leaves', L loc (match { m_grhss = GRHSs grhss' binds }))
 
 replaceLeavesGRHS
         :: [Located (body' (GHC GhcTc))]  -- replacement leaf expressions of that type
diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 56ec6ec6be..c6d8bed746 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -52,6 +52,7 @@ import Name
 import VarSet
 import Rules
 import VarEnv
+import Var( EvVar )
 import Outputable
 import Module
 import SrcLoc
@@ -79,7 +80,7 @@ dsTopLHsBinds binds
      -- see Note [Strict binds checks]
   | not (isEmptyBag unlifted_binds) || not (isEmptyBag bang_binds)
   = do { mapBagM_ (top_level_err "bindings for unlifted types") unlifted_binds
-       ; mapBagM_ (top_level_err "strict pattern bindings")    bang_binds
+       ; mapBagM_ (top_level_err "strict bindings")             bang_binds
        ; return nilOL }
 
   | otherwise
@@ -93,7 +94,7 @@ dsTopLHsBinds binds
 
   where
     unlifted_binds = filterBag (isUnliftedHsBind . unLoc) binds
-    bang_binds     = filterBag (isBangedPatBind  . unLoc) binds
+    bang_binds     = filterBag (isBangedHsBind   . unLoc) binds
 
     top_level_err desc (L loc bind)
       = putSrcSpanDs loc $
@@ -105,8 +106,7 @@ dsTopLHsBinds binds
 -- later be forced in the binding group body, see Note [Desugar Strict binds]
 dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
 dsLHsBinds binds
-  = do { MASSERT( allBag (not . isUnliftedHsBind . unLoc) binds )
-       ; ds_bs <- mapBagM dsLHsBind binds
+  = do { ds_bs <- mapBagM dsLHsBind binds
        ; return (foldBag (\(a, a') (b, b') -> (a ++ b, a' ++ b'))
                          id ([], []) ds_bs) }
 
@@ -124,10 +124,9 @@ dsHsBind :: DynFlags
          -- binding group see Note [Desugar Strict binds] and all
          -- bindings and their desugared right hand sides.
 
-dsHsBind dflags
-         (VarBind { var_id = var
-                  , var_rhs = expr
-                  , var_inline = inline_regardless })
+dsHsBind dflags (VarBind { var_id = var
+                         , var_rhs = expr
+                         , var_inline = inline_regardless })
   = do  { core_expr <- dsLExpr expr
                 -- Dictionary bindings are always VarBinds,
                 -- so we only need do this here
@@ -139,9 +138,8 @@ dsHsBind dflags
                           else []
         ; return (force_var, [core_bind]) }
 
-dsHsBind dflags
-         b@(FunBind { fun_id = L _ fun, fun_matches = matches
-                    , fun_co_fn = co_fn, fun_tick = tick })
+dsHsBind dflags b@(FunBind { fun_id = L _ fun, fun_matches = matches
+                           , fun_co_fn = co_fn, fun_tick = tick })
  = do   { (args, body) <- matchWrapper
                            (mkPrefixFunRhs (noLoc $ idName fun))
                            Nothing matches
@@ -154,16 +152,18 @@ dsHsBind dflags
                 | xopt LangExt.Strict dflags
                 , matchGroupArity matches == 0 -- no need to force lambdas
                 = [id]
-                | isBangedBind b
+                | isBangedHsBind b
                 = [id]
                 | otherwise
                 = []
-        ; --pprTrace "dsHsBind" (ppr fun <+> ppr (idInlinePragma fun) $$ ppr (mg_alts matches) $$ ppr args $$ ppr core_binds) $
-           return (force_var, [core_binds]) }
-
-dsHsBind dflags
-         (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty
-                  , pat_ticks = (rhs_tick, var_ticks) })
+        ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun)
+          --                          , ppr (mg_alts matches)
+          --                          , ppr args, ppr core_binds]) $
+          return (force_var, [core_binds]) }
+
+dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss
+                         , pat_rhs_ty = ty
+                         , pat_ticks = (rhs_tick, var_ticks) })
   = do  { body_expr <- dsGuarded grhss ty
         ; let body' = mkOptTickBox rhs_tick body_expr
               pat'  = decideBangHood dflags pat
@@ -175,47 +175,73 @@ dsHsBind dflags
                            else []
         ; return (force_var', sel_binds) }
 
-        -- A common case: one exported variable, only non-strict binds
-        -- Non-recursive bindings come through this way
-        -- So do self-recursive bindings
-        -- Bindings with complete signatures are AbsBindsSigs, below
-dsHsBind dflags
-         (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = dicts
-                   , abs_exports = [export]
-                   , abs_ev_binds = ev_binds, abs_binds = binds })
-  | ABE { abe_wrap = wrap, abe_poly = global
-        , abe_mono = local, abe_prags = prags } <- export
-  , not (xopt LangExt.Strict dflags)             -- Handle strict binds
-  , not (anyBag (isBangedBind . unLoc) binds)    --        in the next case
-  = -- See Note [AbsBinds wrappers] in HsBinds
-    addDictsDs (toTcTypeBag (listToBag dicts)) $
-         -- addDictsDs: push type constraints deeper for pattern match check
-    do { (force_vars, bind_prs) <- dsLHsBinds binds
-       ; ds_binds <- dsTcEvBinds_s ev_binds
-       ; core_wrap <- dsHsWrapper wrap -- Usually the identity
+dsHsBind dflags (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = dicts
+                          , abs_exports = exports
+                          , abs_ev_binds = ev_binds
+                          , abs_binds = binds, abs_sig = has_sig })
+  = do { ds_binds <- addDictsDs (toTcTypeBag (listToBag dicts)) $
+                     dsLHsBinds binds
+                                   -- addDictsDs: push type constraints deeper
+                                   --             for inner pattern match check
+
+       ; ds_ev_binds <- dsTcEvBinds_s ev_binds
+
+       -- dsAbsBinds does the hard work
+       ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig }
+
+dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind"
+
+
+-----------------------
+dsAbsBinds :: DynFlags
+           -> [TyVar] -> [EvVar] -> [ABExport GhcTc]
+           -> [CoreBind]                -- Desugared evidence bindings
+           -> ([Id], [(Id,CoreExpr)])   -- Desugared value bindings
+           -> Bool                      -- Single binding with signature
+           -> DsM ([Id], [(Id,CoreExpr)])
+
+dsAbsBinds dflags tyvars dicts exports
+           ds_ev_binds (force_vars, bind_prs) has_sig
+
+    -- A very important common case: one exported variable
+    -- Non-recursive bindings come through this way
+    -- So do self-recursive bindings
+  | [export] <- exports
+  , ABE { abe_poly = global_id, abe_mono = local_id
+        , abe_wrap = wrap, abe_prags = prags } <- export
+  , Just force_vars' <- case force_vars of
+                           []                  -> Just []
+                           [v] | v == local_id -> Just [global_id]
+                           _                   -> Nothing
+       -- If there is a variable to force, it's just the
+       -- single variable we are binding here
+  = do { core_wrap <- dsHsWrapper wrap -- Usually the identity
 
        ; let rhs = core_wrap $
                    mkLams tyvars $ mkLams dicts $
-                   mkCoreLets ds_binds $
-                   mkLetRec bind_prs $
-                   Var local
+                   mkCoreLets ds_ev_binds $
+                   body
+
+             body | has_sig
+                  , [(_, lrhs)] <- bind_prs
+                  = lrhs
+                  | otherwise
+                  = mkLetRec bind_prs (Var local_id)
+
        ; (spec_binds, rules) <- dsSpecs rhs prags
 
-       ; let   global'  = addIdSpecialisations global rules
-               main_bind = makeCorePair dflags global' (isDefaultMethod prags)
-                                        (dictArity dicts) rhs
+       ; let global_id' = addIdSpecialisations global_id rules
+             main_bind  = makeCorePair dflags global_id'
+                                       (isDefaultMethod prags)
+                                       (dictArity dicts) rhs
 
-       ; ASSERT(null force_vars)
-         return ([], main_bind : fromOL spec_binds) }
+       ; return (force_vars', main_bind : fromOL spec_binds) }
 
-        -- Another common case: no tyvars, no dicts
-        -- In this case we can have a much simpler desugaring
-dsHsBind dflags
-         (AbsBinds { abs_tvsa = [], abs_ev_varsa = []
-                   , abs_exports = exports
-                   , abs_ev_binds = ev_binds, abs_binds = binds })
-  = do { (force_vars, bind_prs) <- dsLHsBinds binds
-       ; let mk_bind (ABE { abe_wrap = wrap
+    -- Another common case: no tyvars, no dicts
+    -- In this case we can have a much simpler desugaring
+  | null tyvars, null dicts
+
+  = do { let mk_bind (ABE { abe_wrap = wrap
                           , abe_poly = global
                           , abe_mono = local
                           , abe_prags = prags })
@@ -225,42 +251,35 @@ dsHsBind dflags
                                           0 (core_wrap (Var local))) }
        ; main_binds <- mapM mk_bind exports
 
-       ; ds_binds <- dsTcEvBinds_s ev_binds
-       ; return (force_vars, flattenBinds ds_binds ++ bind_prs ++ main_binds) }
-
-dsHsBind dflags
-         (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = dicts
-                   , abs_exports = exports, abs_ev_binds = ev_binds
-                   , abs_binds = binds })
-         -- See Note [Desugaring AbsBinds]
-  = addDictsDs (toTcTypeBag (listToBag dicts)) $
-         -- addDictsDs: push type constraints deeper for pattern match check
-     do { (local_force_vars, bind_prs) <- dsLHsBinds binds
-        ; let core_bind = Rec [ makeCorePair dflags (add_inline lcl_id) False 0 rhs
+       ; return (force_vars, flattenBinds ds_ev_binds ++ bind_prs ++ main_binds) }
+
+    -- The general case
+    -- See Note [Desugaring AbsBinds]
+  | otherwise
+  = do { let core_bind = Rec [ makeCorePair dflags (add_inline lcl_id) False 0 rhs
                               | (lcl_id, rhs) <- bind_prs ]
                 -- Monomorphic recursion possible, hence Rec
-              new_force_vars = get_new_force_vars local_force_vars
-              locals       = map abe_mono exports
-              all_locals   = locals ++ new_force_vars
-              tup_expr     = mkBigCoreVarTup all_locals
-              tup_ty       = exprType tup_expr
-        ; ds_binds <- dsTcEvBinds_s ev_binds
-        ; let poly_tup_rhs = mkLams tyvars $ mkLams dicts $
-                             mkCoreLets ds_binds $
-                             mkLet core_bind $
-                             tup_expr
-
-        ; poly_tup_id <- newSysLocalDs (exprType poly_tup_rhs)
+             new_force_vars = get_new_force_vars force_vars
+             locals       = map abe_mono exports
+             all_locals   = locals ++ new_force_vars
+             tup_expr     = mkBigCoreVarTup all_locals
+             tup_ty       = exprType tup_expr
+       ; let poly_tup_rhs = mkLams tyvars $ mkLams dicts $
+                            mkCoreLets ds_ev_binds $
+                            mkLet core_bind $
+                            tup_expr
+
+       ; poly_tup_id <- newSysLocalDs (exprType poly_tup_rhs)
 
         -- Find corresponding global or make up a new one: sometimes
         -- we need to make new export to desugar strict binds, see
         -- Note [Desugar Strict binds]
-        ; (exported_force_vars, extra_exports) <- get_exports local_force_vars
+       ; (exported_force_vars, extra_exports) <- get_exports force_vars
 
-        ; let mk_bind (ABE { abe_wrap = wrap
-                           , abe_poly = global
-                           , abe_mono = local, abe_prags = spec_prags })
-                         -- See Note [AbsBinds wrappers] in HsBinds
+       ; let mk_bind (ABE { abe_wrap = wrap
+                          , abe_poly = global
+                          , abe_mono = local, abe_prags = spec_prags })
+                          -- See Note [AbsBinds wrappers] in HsBinds
                 = do { tup_id  <- newSysLocalDs tup_ty
                      ; core_wrap <- dsHsWrapper wrap
                      ; let rhs = core_wrap $ mkLams tyvars $ mkLams dicts $
@@ -275,10 +294,10 @@ dsHsBind dflags
                            -- Id is just the selector.  Hmm.
                      ; return ((global', rhs) : fromOL spec_binds) }
 
-        ; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
+       ; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
 
-        ; return (exported_force_vars
-                 ,(poly_tup_id, poly_tup_rhs) :
+       ; return ( exported_force_vars
+                , (poly_tup_id, poly_tup_rhs) :
                    concat export_binds_s) }
   where
     inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with
@@ -321,57 +340,10 @@ dsHsBind dflags
     mk_export local =
       do global <- newSysLocalDs
                      (exprType (mkLams tyvars (mkLams dicts (Var local))))
-         return (ABE {abe_poly = global
-                     ,abe_mono = local
-                     ,abe_wrap = WpHole
-                     ,abe_prags = SpecPrags []})
-
--- AbsBindsSig is a combination of AbsBinds and FunBind
-dsHsBind dflags (AbsBindsSig { abs_tvs = tyvars, abs_ev_vars = dicts
-                             , abs_sig_export  = global
-                             , abs_sig_prags   = prags
-                             , abs_sig_ev_bind = ev_bind
-                             , abs_sig_bind    = bind })
-  | L bind_loc FunBind { fun_matches = matches
-                       , fun_co_fn   = co_fn
-                       , fun_tick    = tick } <- bind
-  = putSrcSpanDs bind_loc $
-    addDictsDs (toTcTypeBag (listToBag dicts)) $
-             -- addDictsDs: push type constraints deeper for pattern match check
-    do { (args, body) <- matchWrapper
-                           (mkPrefixFunRhs (noLoc $ idName global))
-                           Nothing matches
-       ; core_wrap <- dsHsWrapper co_fn
-       ; let body'   = mkOptTickBox tick body
-             fun_rhs = core_wrap (mkLams args body')
-             force_vars
-               | xopt LangExt.Strict dflags
-               , matchGroupArity matches == 0 -- no need to force lambdas
-               = [global]
-               | isBangedBind (unLoc bind)
-               = [global]
-               | otherwise
-               = []
-
-       ; ds_binds <- dsTcEvBinds ev_bind
-       ; let rhs = mkLams tyvars $
-                   mkLams dicts $
-                   mkCoreLets ds_binds $
-                   fun_rhs
-
-       ; (spec_binds, rules) <- dsSpecs rhs prags
-       ; let global' = addIdSpecialisations global rules
-             main_bind = makeCorePair dflags global' (isDefaultMethod prags)
-                                      (dictArity dicts) rhs
-
-       ; return (force_vars, main_bind : fromOL spec_binds) }
-
-  | otherwise
-  = pprPanic "dsHsBind: AbsBindsSig" (ppr bind)
-
-dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind"
-
-
+         return (ABE { abe_poly  = global
+                     , abe_mono  = local
+                     , abe_wrap  = WpHole
+                     , abe_prags = SpecPrags [] })
 
 -- | This is where we apply INLINE and INLINABLE pragmas. All we need to
 -- do is to attach the unfolding information to the Id.
@@ -631,7 +603,7 @@ We define an "unlifted bind" to be any bind that binds an unlifted id. Note that
 
 is *not* an unlifted bind. Unlifted binds are detected by HsUtils.isUnliftedHsBind.
 
-Define a "banged bind" to have a top-level bang. Detected by HsPat.isBangedPatBind.
+Define a "banged bind" to have a top-level bang. Detected by HsPat.isBangedHsBind.
 Define a "strict bind" to be either an unlifted bind or a banged bind.
 
 The restrictions are:
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index d2f35fc57e..21e7872358 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -130,8 +130,6 @@ ds_val_bind (NonRecursive, hsbinds) body
   where
     is_polymorphic (AbsBinds { abs_tvsa = tvs, abs_ev_varsa = evs })
                      = not (null tvs && null evs)
-    is_polymorphic (AbsBindsSig { abs_tvs = tvs, abs_ev_vars = evs })
-                     = not (null tvs && null evs)
     is_polymorphic _ = False
 
     unlifted_must_be_bang bind
@@ -186,15 +184,6 @@ dsUnliftedBind (AbsBinds { abs_tvsa = [], abs_ev_varsa = []
        ; ds_binds <- dsTcEvBinds_s ev_binds
        ; return (mkCoreLets ds_binds body2) }
 
-dsUnliftedBind (AbsBindsSig { abs_tvs         = []
-                            , abs_ev_vars     = []
-                            , abs_sig_export  = poly
-                            , abs_sig_ev_bind = ev_bind
-                            , abs_sig_bind    = L _ bind }) body
-  = do { ds_binds <- dsTcEvBinds ev_bind
-       ; body' <- dsUnliftedBind (bind { fun_id = noLoc poly }) body
-       ; return (mkCoreLets ds_binds body') }
-
 dsUnliftedBind (FunBind { fun_id = L l fun
                         , fun_matches = matches
                         , fun_co_fn = co_fn
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 56bde9254c..17d0731f8d 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -307,7 +307,7 @@ repRoleD (L loc (RoleAnnotDecl tycon roles))
        ; return (loc, dec) }
 
 -------------------------
-repDataDefn :: Core TH.Name -> Core [TH.TyVarBndr]
+repDataDefn :: Core TH.Name -> Core [TH.TyVarBndrQ]
             -> Maybe (Core [TH.TypeQ])
             -> HsDataDefn GhcRn
             -> DsM (Core TH.DecQ)
@@ -318,20 +318,20 @@ repDataDefn tc bndrs opt_tys
        ; derivs1  <- repDerivs mb_derivs
        ; case (new_or_data, cons) of
            (NewType, [con])  -> do { con'  <- repC con
-                                   ; ksig' <- repMaybeLKind ksig
+                                   ; ksig' <- repMaybeLTy ksig
                                    ; repNewtype cxt1 tc bndrs opt_tys ksig' con'
                                                 derivs1 }
            (NewType, _) -> failWithDs (text "Multiple constructors for newtype:"
                                        <+> pprQuotedList
                                        (getConNames $ unLoc $ head cons))
-           (DataType, _) -> do { ksig' <- repMaybeLKind ksig
+           (DataType, _) -> do { ksig' <- repMaybeLTy ksig
                                ; consL <- mapM repC cons
                                ; cons1 <- coreList conQTyConName consL
                                ; repData cxt1 tc bndrs opt_tys ksig' cons1
                                          derivs1 }
        }
 
-repSynDecl :: Core TH.Name -> Core [TH.TyVarBndr]
+repSynDecl :: Core TH.Name -> Core [TH.TyVarBndrQ]
            -> LHsType GhcRn
            -> DsM (Core TH.DecQ)
 repSynDecl tc bndrs ty
@@ -373,9 +373,9 @@ repFamilyDecl decl@(L loc (FamilyDecl { fdInfo      = info,
        }
 
 -- | Represent result signature of a type family
-repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSig)
+repFamilyResultSig :: FamilyResultSig GhcRn -> DsM (Core TH.FamilyResultSigQ)
 repFamilyResultSig  NoSig          = repNoSig
-repFamilyResultSig (KindSig ki)    = do { ki' <- repLKind ki
+repFamilyResultSig (KindSig ki)    = do { ki' <- repLTy ki
                                         ; repKindSig ki' }
 repFamilyResultSig (TyVarSig bndr) = do { bndr' <- repTyVarBndr bndr
                                         ; repTyVarSig bndr' }
@@ -384,12 +384,12 @@ repFamilyResultSig (TyVarSig bndr) = do { bndr' <- repTyVarBndr bndr
 -- where the result signature can be either missing or a kind but never a named
 -- result variable.
 repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
-                              -> DsM (Core (Maybe TH.Kind))
+                              -> DsM (Core (Maybe TH.KindQ))
 repFamilyResultSigToMaybeKind NoSig =
-    do { coreNothing kindTyConName }
+    do { coreNothing kindQTyConName }
 repFamilyResultSigToMaybeKind (KindSig ki) =
-    do { ki' <- repLKind ki
-       ; coreJust kindTyConName ki' }
+    do { ki' <- repLTy ki
+       ; coreJust kindQTyConName ki' }
 repFamilyResultSigToMaybeKind _ = panic "repFamilyResultSigToMaybeKind"
 
 -- | Represent injectivity annotation of a type family
@@ -769,7 +769,7 @@ rep_wc_ty_sig mk_sig loc sig_ty nm
   = do { nm1 <- lookupLOcc nm
        ; let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)
                                      ; repTyVarBndrWithKind tv name }
-       ; th_explicit_tvs <- repList tyVarBndrTyConName rep_in_scope_tv
+       ; th_explicit_tvs <- repList tyVarBndrQTyConName rep_in_scope_tv
                                     explicit_tvs
          -- NB: Don't pass any implicit type variables to repList above
          -- See Note [Don't quantify implicit type variables in quotes]
@@ -865,7 +865,7 @@ addSimpleTyVarBinds names thing_inside
        ; wrapGenSyms fresh_names term }
 
 addTyVarBinds :: LHsQTyVars GhcRn                    -- the binders to be added
-              -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))  -- action in the ext env
+              -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))  -- action in the ext env
               -> DsM (Core (TH.Q a))
 -- gensym a list of type variables and enter them into the meta environment;
 -- the computations passed as the second argument is executed in that extended
@@ -876,7 +876,7 @@ addTyVarBinds (HsQTvs { hsq_implicit = imp_tvs, hsq_explicit = exp_tvs }) m
        ; fresh_exp_names <- mkGenSyms (map hsLTyVarName exp_tvs)
        ; let fresh_names = fresh_imp_names ++ fresh_exp_names
        ; term <- addBinds fresh_names $
-                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr
+                 do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr
                                      (exp_tvs `zip` fresh_exp_names)
                     ; m kbs }
        ; wrapGenSyms fresh_names term }
@@ -884,7 +884,7 @@ addTyVarBinds (HsQTvs { hsq_implicit = imp_tvs, hsq_explicit = exp_tvs }) m
     mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
 
 addTyClTyVarBinds :: LHsQTyVars GhcRn
-                  -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))
+                  -> (Core [TH.TyVarBndrQ] -> DsM (Core (TH.Q a)))
                   -> DsM (Core (TH.Q a))
 
 -- Used for data/newtype declarations, and family instances,
@@ -900,29 +900,31 @@ addTyClTyVarBinds tvs m
             -- This makes things work for family declarations
 
        ; term <- addBinds freshNames $
-                 do { kbs <- repList tyVarBndrTyConName mk_tv_bndr (hsQTvExplicit tvs)
+                 do { kbs <- repList tyVarBndrQTyConName mk_tv_bndr
+                                     (hsQTvExplicit tvs)
                     ; m kbs }
 
        ; wrapGenSyms freshNames term }
   where
+    mk_tv_bndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)
     mk_tv_bndr tv = do { v <- lookupBinder (hsLTyVarName tv)
                        ; repTyVarBndrWithKind tv v }
 
 -- Produce kinded binder constructors from the Haskell tyvar binders
 --
 repTyVarBndrWithKind :: LHsTyVarBndr GhcRn
-                     -> Core TH.Name -> DsM (Core TH.TyVarBndr)
+                     -> Core TH.Name -> DsM (Core TH.TyVarBndrQ)
 repTyVarBndrWithKind (L _ (UserTyVar _)) nm
   = repPlainTV nm
 repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) nm
-  = repLKind ki >>= repKindedTV nm
+  = repLTy ki >>= repKindedTV nm
 
 -- | Represent a type variable binder
-repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndr)
+repTyVarBndr :: LHsTyVarBndr GhcRn -> DsM (Core TH.TyVarBndrQ)
 repTyVarBndr (L _ (UserTyVar (L _ nm)) )= do { nm' <- lookupBinder nm
                                              ; repPlainTV nm' }
 repTyVarBndr (L _ (KindedTyVar (L _ nm) ki)) = do { nm' <- lookupBinder nm
-                                                  ; ki' <- repLKind ki
+                                                  ; ki' <- repLTy ki
                                                   ; repKindedTV nm' ki' }
 
 -- represent a type context
@@ -996,6 +998,8 @@ repTy ty@(HsForAllTy {}) = repForall ty
 repTy ty@(HsQualTy {})   = repForall ty
 
 repTy (HsTyVar _ (L _ n))
+  | isLiftedTypeKindTyConName n       = repTStar
+  | n `hasKey` constraintKindTyConKey = repTConstraint
   | isTvOcc occ   = do tv1 <- lookupOcc n
                        repTvar tv1
   | isDataOcc occ = do tc1 <- lookupOcc n
@@ -1044,7 +1048,7 @@ repTy (HsEqTy t1 t2) = do
                          repTapps eq [t1', t2']
 repTy (HsKindSig t k)       = do
                                 t1 <- repLTy t
-                                k1 <- repLKind k
+                                k1 <- repLTy k
                                 repTSig t1 k1
 repTy (HsSpliceTy splice _)     = repSplice splice
 repTy (HsExplicitListTy _ _ tys) = do
@@ -1068,59 +1072,14 @@ repTyLit (HsStrTy _ s) = do { s' <- mkStringExprFS s
                             ; rep2 strTyLitName [s']
                             }
 
--- represent a kind
---
--- It would be great to scrap this function in favor of repLTy, since Types
--- and Kinds are the same things. We have not done so yet for engineering
--- reasons, as repLTy returns a monadic TypeQ, whereas repLKind returns a pure
--- Kind, so in order to replace repLKind with repLTy, we'd need to go through
--- and purify repLTy and every monadic function it calls. This is the subject
--- GHC Trac #11785.
-repLKind :: LHsKind GhcRn -> DsM (Core TH.Kind)
-repLKind ki
-  = do { let (kis, ki') = splitHsFunType ki
-       ; kis_rep <- mapM repLKind kis
-       ; ki'_rep <- repNonArrowLKind ki'
-       ; kcon <- repKArrow
-       ; let f k1 k2 = repKApp kcon k1 >>= flip repKApp k2
-       ; foldrM f ki'_rep kis_rep
-       }
-
--- | Represent a kind wrapped in a Maybe
-repMaybeLKind :: Maybe (LHsKind GhcRn)
-              -> DsM (Core (Maybe TH.Kind))
-repMaybeLKind Nothing =
-    do { coreNothing kindTyConName }
-repMaybeLKind (Just ki) =
-    do { ki' <- repLKind ki
-       ; coreJust kindTyConName ki' }
-
-repNonArrowLKind :: LHsKind GhcRn -> DsM (Core TH.Kind)
-repNonArrowLKind (L _ ki) = repNonArrowKind ki
-
-repNonArrowKind :: HsKind GhcRn -> DsM (Core TH.Kind)
-repNonArrowKind (HsTyVar _ (L _ name))
-  | isLiftedTypeKindTyConName name       = repKStar
-  | name `hasKey` constraintKindTyConKey = repKConstraint
-  | isTvOcc (nameOccName name)      = lookupOcc name >>= repKVar
-  | otherwise                       = lookupOcc name >>= repKCon
-repNonArrowKind (HsAppTy f a)       = do  { f' <- repLKind f
-                                          ; a' <- repLKind a
-                                          ; repKApp f' a'
-                                          }
-repNonArrowKind (HsListTy k)        = do  { k' <- repLKind k
-                                          ; kcon <- repKList
-                                          ; repKApp kcon k'
-                                          }
-repNonArrowKind (HsTupleTy _ ks)    = do  { ks' <- mapM repLKind ks
-                                          ; kcon <- repKTuple (length ks)
-                                          ; repKApps kcon ks'
-                                          }
-repNonArrowKind (HsKindSig k sort)  = do  { k'    <- repLKind k
-                                          ; sort' <- repLKind sort
-                                          ; repKSig k' sort'
-                                          }
-repNonArrowKind k                   = notHandled "Exotic form of kind" (ppr k)
+-- | Represent a type wrapped in a Maybe
+repMaybeLTy :: Maybe (LHsKind GhcRn)
+            -> DsM (Core (Maybe TH.TypeQ))
+repMaybeLTy Nothing =
+    do { coreNothing kindQTyConName }
+repMaybeLTy (Just ki) =
+    do { ki' <- repLTy ki
+       ; coreJust kindQTyConName ki' }
 
 repRole :: Located (Maybe Role) -> DsM (Core TH.Role)
 repRole (L _ (Just Nominal))          = rep2 nominalRName []
@@ -1299,7 +1258,7 @@ repE e                     = notHandled "Expression form" (ppr e)
 -- Building representations of auxillary structures like Match, Clause, Stmt,
 
 repMatchTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.MatchQ)
-repMatchTup (L _ (Match _ [p] _ (GRHSs guards (L _ wheres)))) =
+repMatchTup (L _ (Match { m_pats = [p], m_grhss = GRHSs guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatBinders p)
      ; addBinds ss1 $ do {
      ; p1 <- repLP p
@@ -1311,7 +1270,7 @@ repMatchTup (L _ (Match _ [p] _ (GRHSs guards (L _ wheres)))) =
 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
 
 repClauseTup ::  LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ClauseQ)
-repClauseTup (L _ (Match _ ps _ (GRHSs guards (L _ wheres)))) =
+repClauseTup (L _ (Match { m_pats = ps, m_grhss = GRHSs guards (L _ wheres) })) =
   do { ss1 <- mkGenSyms (collectPatsBinders ps)
      ; addBinds ss1 $ do {
        ps1 <- repLPs ps
@@ -1481,8 +1440,8 @@ rep_bind :: LHsBind GhcRn -> DsM (SrcSpan, Core TH.DecQ)
 rep_bind (L loc (FunBind
                  { fun_id = fn,
                    fun_matches = MG { mg_alts
-                           = L _ [L _ (Match _ [] _
-                                             (GRHSs guards (L _ wheres)))] } }))
+                           = L _ [L _ (Match { m_pats = []
+                                             , m_grhss = GRHSs guards (L _ wheres) })] } }))
  = do { (ss,wherecore) <- repBinds wheres
         ; guardcore <- addBinds ss (repGuards guards)
         ; fn'  <- lookupLBinder fn
@@ -1517,7 +1476,6 @@ rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
         ; return (srcLocSpan (getSrcLoc v), ans) }
 
 rep_bind (L _ (AbsBinds {}))  = panic "rep_bind: AbsBinds"
-rep_bind (L _ (AbsBindsSig {})) = panic "rep_bind: AbsBindsSig"
 rep_bind (L loc (PatSynBind (PSB { psb_id   = syn
                                  , psb_fvs  = _fvs
                                  , psb_args = args
@@ -1624,7 +1582,8 @@ repExplBidirPatSynDir (MkC cls) = rep2 explBidirPatSynName [cls]
 -- (\ p1 .. pn -> exp) by causing an error.
 
 repLambda :: LMatch GhcRn (LHsExpr GhcRn) -> DsM (Core TH.ExpQ)
-repLambda (L _ (Match _ ps _ (GRHSs [L _ (GRHS [] e)] (L _ EmptyLocalBinds))))
+repLambda (L _ (Match { m_pats = ps
+                      , m_grhss = GRHSs [L _ (GRHS [] e)] (L _ EmptyLocalBinds) } ))
  = do { let bndrs = collectPatsBinders ps ;
       ; ss  <- mkGenSyms bndrs
       ; lam <- addBinds ss (
@@ -2046,8 +2005,8 @@ repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
 
-repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
-        -> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.Kind)
+repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndrQ]
+        -> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.KindQ)
         -> Core [TH.ConQ] -> Core [TH.DerivClauseQ] -> DsM (Core TH.DecQ)
 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC ksig) (MkC cons) (MkC derivs)
   = rep2 dataDName [cxt, nm, tvs, ksig, cons, derivs]
@@ -2055,8 +2014,8 @@ repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC ksig) (MkC cons)
         (MkC derivs)
   = rep2 dataInstDName [cxt, nm, tys, ksig, cons, derivs]
 
-repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
-           -> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.Kind)
+repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndrQ]
+           -> Maybe (Core [TH.TypeQ]) -> Core (Maybe TH.KindQ)
            -> Core TH.ConQ -> Core [TH.DerivClauseQ] -> DsM (Core TH.DecQ)
 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC ksig) (MkC con)
            (MkC derivs)
@@ -2065,7 +2024,7 @@ repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC ksig) (MkC con)
            (MkC derivs)
   = rep2 newtypeInstDName [cxt, nm, tys, ksig, con, derivs]
 
-repTySyn :: Core TH.Name -> Core [TH.TyVarBndr]
+repTySyn :: Core TH.Name -> Core [TH.TyVarBndrQ]
          -> Core TH.TypeQ -> DsM (Core TH.DecQ)
 repTySyn (MkC nm) (MkC tvs) (MkC rhs)
   = rep2 tySynDName [nm, tvs, rhs]
@@ -2105,7 +2064,7 @@ repOverlap mb =
   just    = coreJust overlapTyConName
 
 
-repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
+repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndrQ]
          -> Core [TH.FunDep] -> Core [TH.DecQ]
          -> DsM (Core TH.DecQ)
 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
@@ -2150,22 +2109,22 @@ repTySynInst :: Core TH.Name -> Core TH.TySynEqnQ -> DsM (Core TH.DecQ)
 repTySynInst (MkC nm) (MkC eqn)
     = rep2 tySynInstDName [nm, eqn]
 
-repDataFamilyD :: Core TH.Name -> Core [TH.TyVarBndr]
-               -> Core (Maybe TH.Kind) -> DsM (Core TH.DecQ)
+repDataFamilyD :: Core TH.Name -> Core [TH.TyVarBndrQ]
+               -> Core (Maybe TH.KindQ) -> DsM (Core TH.DecQ)
 repDataFamilyD (MkC nm) (MkC tvs) (MkC kind)
     = rep2 dataFamilyDName [nm, tvs, kind]
 
 repOpenFamilyD :: Core TH.Name
-               -> Core [TH.TyVarBndr]
-               -> Core TH.FamilyResultSig
+               -> Core [TH.TyVarBndrQ]
+               -> Core TH.FamilyResultSigQ
                -> Core (Maybe TH.InjectivityAnn)
                -> DsM (Core TH.DecQ)
 repOpenFamilyD (MkC nm) (MkC tvs) (MkC result) (MkC inj)
     = rep2 openTypeFamilyDName [nm, tvs, result, inj]
 
 repClosedFamilyD :: Core TH.Name
-                 -> Core [TH.TyVarBndr]
-                 -> Core TH.FamilyResultSig
+                 -> Core [TH.TyVarBndrQ]
+                 -> Core TH.FamilyResultSigQ
                  -> Core (Maybe TH.InjectivityAnn)
                  -> Core [TH.TySynEqnQ]
                  -> DsM (Core TH.DecQ)
@@ -2251,7 +2210,7 @@ repConstr _ _ _ =
 
 ------------ Types -------------------
 
-repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ
+repTForall :: Core [TH.TyVarBndrQ] -> Core TH.CxtQ -> Core TH.TypeQ
            -> DsM (Core TH.TypeQ)
 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
     = rep2 forallTName [tvars, ctxt, ty]
@@ -2266,7 +2225,7 @@ repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
 repTapps f []     = return f
 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
 
-repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
+repTSig :: Core TH.TypeQ -> Core TH.KindQ -> DsM (Core TH.TypeQ)
 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
 
 repTequality :: DsM (Core TH.TypeQ)
@@ -2286,6 +2245,12 @@ repTLit (MkC lit) = rep2 litTName [lit]
 repTWildCard :: DsM (Core TH.TypeQ)
 repTWildCard = rep2 wildCardTName []
 
+repTStar :: DsM (Core TH.TypeQ)
+repTStar = rep2 starKName []
+
+repTConstraint :: DsM (Core TH.TypeQ)
+repTConstraint = rep2 constraintKName []
+
 --------- Type constructors --------------
 
 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
@@ -2325,56 +2290,24 @@ repPromotedNilTyCon = rep2 promotedNilTName []
 repPromotedConsTyCon :: DsM (Core TH.TypeQ)
 repPromotedConsTyCon = rep2 promotedConsTName []
 
------------- Kinds -------------------
+------------ TyVarBndrs -------------------
 
-repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
+repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndrQ)
 repPlainTV (MkC nm) = rep2 plainTVName [nm]
 
-repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr)
+repKindedTV :: Core TH.Name -> Core TH.KindQ -> DsM (Core TH.TyVarBndrQ)
 repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]
 
-repKVar :: Core TH.Name -> DsM (Core TH.Kind)
-repKVar (MkC s) = rep2 varKName [s]
-
-repKCon :: Core TH.Name -> DsM (Core TH.Kind)
-repKCon (MkC s) = rep2 conKName [s]
-
-repKTuple :: Int -> DsM (Core TH.Kind)
-repKTuple i = do dflags <- getDynFlags
-                 rep2 tupleKName [mkIntExprInt dflags i]
-
-repKArrow :: DsM (Core TH.Kind)
-repKArrow = rep2 arrowKName []
-
-repKList :: DsM (Core TH.Kind)
-repKList = rep2 listKName []
-
-repKApp :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
-repKApp (MkC k1) (MkC k2) = rep2 appKName [k1, k2]
-
-repKApps :: Core TH.Kind -> [Core TH.Kind] -> DsM (Core TH.Kind)
-repKApps f []     = return f
-repKApps f (k:ks) = do { f' <- repKApp f k; repKApps f' ks }
-
-repKStar :: DsM (Core TH.Kind)
-repKStar = rep2 starKName []
-
-repKConstraint :: DsM (Core TH.Kind)
-repKConstraint = rep2 constraintKName []
-
-repKSig :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
-repKSig (MkC k) (MkC sort) = rep2 sigTDataConName [k, sort]
-
 ----------------------------------------------------------
 --       Type family result signature
 
-repNoSig :: DsM (Core TH.FamilyResultSig)
+repNoSig :: DsM (Core TH.FamilyResultSigQ)
 repNoSig = rep2 noSigName []
 
-repKindSig :: Core TH.Kind -> DsM (Core TH.FamilyResultSig)
+repKindSig :: Core TH.KindQ -> DsM (Core TH.FamilyResultSigQ)
 repKindSig (MkC ki) = rep2 kindSigName [ki]
 
-repTyVarSig :: Core TH.TyVarBndr -> DsM (Core TH.FamilyResultSig)
+repTyVarSig :: Core TH.TyVarBndrQ -> DsM (Core TH.FamilyResultSigQ)
 repTyVarSig (MkC bndr) = rep2 tyVarSigName [bndr]
 
 ----------------------------------------------------------
diff --git a/compiler/deSugar/Match.hs b/compiler/deSugar/Match.hs
index a870c6f9c3..95cf40dcf2 100644
--- a/compiler/deSugar/Match.hs
+++ b/compiler/deSugar/Match.hs
@@ -749,14 +749,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches
                          matchEquations ctxt new_vars eqns_info rhs_ty
         ; return (new_vars, result_expr) }
   where
-    mk_eqn_info vars (L _ (Match ctx pats _ grhss))
+    mk_eqn_info vars (L _ (Match { m_pats = pats, m_grhss = grhss }))
       = do { dflags <- getDynFlags
-           ; let add_bang
-                   | FunRhs {mc_strictness=SrcStrict} <- ctx
-                   = pprTrace "addBang" empty addBang
-                   | otherwise
-                   = decideBangHood dflags
-                 upats = map (unLoc . add_bang) pats
+           ; let upats = map (unLoc . decideBangHood dflags) pats
                  dicts = toTcTypeBag (collectEvVarsPats upats) -- Only TcTyVars
            ; tm_cs <- genCaseTmCs2 mb_scr upats vars
            ; match_result <- addDictsDs dicts $ -- See Note [Type and Term Equality Propagation]
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index e62b8080a9..98f9f3cb25 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -632,10 +632,3 @@ Library
             RtClosureInspect
             DebuggerUtils
             GHCi
-
-    if !flag(stage1)
-        -- ghc:Serialized moved to ghc-boot:GHC.Serialized.  So for
-        -- compatibility with GHC 7.10 and earlier, we reexport it
-        -- under the old name.
-        reexported-modules:
-            ghc-boot:GHC.Serialized as Serialized
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 2695a98f9e..939d1dd760 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fprof-auto-top #-}
 --
 --  (c) The University of Glasgow 2002-2006
@@ -43,8 +44,10 @@ import ErrUtils
 import Unique
 import FastString
 import Panic
-import StgCmmLayout     ( ArgRep(..), toArgRep, argRepSizeW )
-import SMRep
+import StgCmmClosure    ( NonVoid(..), fromNonVoid, nonVoidIds )
+import StgCmmLayout     ( ArgRep(..), toArgRep, argRepSizeW,
+                          mkVirtHeapOffsets, mkVirtConstrOffsets )
+import SMRep hiding (WordOff, ByteOff, wordsToBytes)
 import Bitmap
 import OrdList
 import Maybes
@@ -68,11 +71,7 @@ import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 import qualified FiniteMap as Map
 import Data.Ord
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
-#else
-import GHC.Stack as GHC.Stack.CCS
-#endif
 
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module
@@ -209,11 +208,33 @@ simpleFreeVars = go . freeVars
 
 type BCInstrList = OrdList BCInstr
 
-type Sequel = Word -- back off to this depth before ENTER
+newtype ByteOff = ByteOff Int
+    deriving (Enum, Eq, Integral, Num, Ord, Real)
+
+newtype WordOff = WordOff Int
+    deriving (Enum, Eq, Integral, Num, Ord, Real)
+
+wordsToBytes :: DynFlags -> WordOff -> ByteOff
+wordsToBytes dflags = fromIntegral . (* wORD_SIZE dflags) . fromIntegral
+
+-- Used when we know we have a whole number of words
+bytesToWords :: DynFlags -> ByteOff -> WordOff
+bytesToWords dflags (ByteOff bytes) =
+    let (q, r) = bytes `quotRem` (wORD_SIZE dflags)
+    in if r == 0
+           then fromIntegral q
+           else panic $ "ByteCodeGen.bytesToWords: bytes=" ++ show bytes
+
+wordSize :: DynFlags -> ByteOff
+wordSize dflags = ByteOff (wORD_SIZE dflags)
+
+type Sequel = ByteOff -- back off to this depth before ENTER
+
+type StackDepth = ByteOff
 
 -- | Maps Ids to their stack depth. This allows us to avoid having to mess with
 -- it after each push/pop.
-type BCEnv = Map Id Word -- To find vars on the stack
+type BCEnv = Map Id StackDepth -- To find vars on the stack
 
 {-
 ppBCEnv :: BCEnv -> SDoc
@@ -296,8 +317,6 @@ argBits dflags (rep : args)
 -- Compile code for the right-hand side of a top-level binding
 
 schemeTopBind :: (Id, AnnExpr Id DVarSet) -> BcM (ProtoBCO Name)
-
-
 schemeTopBind (id, rhs)
   | Just data_con <- isDataConWorkId_maybe id,
     isNullaryRepDataCon data_con = do
@@ -358,7 +377,12 @@ collect (_, e) = go [] e
       = go (x:xs) e
     go xs not_lambda = (reverse xs, not_lambda)
 
-schemeR_wrk :: [Id] -> Id -> AnnExpr Id DVarSet -> ([Var], AnnExpr' Var DVarSet) -> BcM (ProtoBCO Name)
+schemeR_wrk
+    :: [Id]
+    -> Id
+    -> AnnExpr Id DVarSet
+    -> ([Var], AnnExpr' Var DVarSet)
+    -> BcM (ProtoBCO Name)
 schemeR_wrk fvs nm original_body (args, body)
    = do
      dflags <- getDynFlags
@@ -369,27 +393,30 @@ schemeR_wrk fvs nm original_body (args, body)
          -- \fv1..fvn x1..xn -> e
          -- i.e. the fvs come first
 
-         szsw_args = map (fromIntegral . idSizeW dflags) all_args
-         szw_args  = sum szsw_args
-         p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsw_args))
+         -- Stack arguments always take a whole number of words, we never pack
+         -- them unlike constructor fields.
+         szsb_args = map (wordsToBytes dflags . idSizeW dflags) all_args
+         sum_szsb_args  = sum szsb_args
+         p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsb_args))
 
          -- make the arg bitmap
          bits = argBits dflags (reverse (map bcIdArgRep all_args))
          bitmap_size = genericLength bits
          bitmap = mkBitmap dflags bits
-     body_code <- schemeER_wrk szw_args p_init body
+     body_code <- schemeER_wrk sum_szsb_args p_init body
 
      emitBc (mkProtoBCO dflags (getName nm) body_code (Right original_body)
                  arity bitmap_size bitmap False{-not alts-})
 
 -- introduce break instructions for ticked expressions
-schemeER_wrk :: Word -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
+schemeER_wrk :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
 schemeER_wrk d p rhs
   | AnnTick (Breakpoint tick_no fvs) (_annot, newRhs) <- rhs
-  = do  code <- schemeE (fromIntegral d) 0 p newRhs
+  = do  code <- schemeE d 0 p newRhs
         cc_arr <- getCCArray
         this_mod <- moduleName <$> getCurrentModule
-        let idOffSets = getVarOffSets d p fvs
+        dflags <- getDynFlags
+        let idOffSets = getVarOffSets dflags d p fvs
         let breakInfo = CgBreakInfo
                         { cgb_vars = idOffSets
                         , cgb_resty = exprType (deAnnotate' newRhs)
@@ -400,10 +427,10 @@ schemeER_wrk d p rhs
                | otherwise = toRemotePtr nullPtr
         let breakInstr = BRK_FUN (fromIntegral tick_no) (getUnique this_mod) cc
         return $ breakInstr `consOL` code
-   | otherwise = schemeE (fromIntegral d) 0 p rhs
+   | otherwise = schemeE d 0 p rhs
 
-getVarOffSets :: Word -> BCEnv -> [Id] -> [(Id, Word16)]
-getVarOffSets depth env = catMaybes . map getOffSet
+getVarOffSets :: DynFlags -> StackDepth -> BCEnv -> [Id] -> [(Id, Word16)]
+getVarOffSets dflags depth env = catMaybes . map getOffSet
   where
     getOffSet id = case lookupBCEnv_maybe id env of
         Nothing     -> Nothing
@@ -415,16 +442,20 @@ getVarOffSets depth env = catMaybes . map getOffSet
             -- this "adjustment" is needed due to stack manipulation for
             -- BRK_FUN in Interpreter.c In any case, this is used only when
             -- we trigger a breakpoint.
-            let adjustment = 2
-            in Just (id, trunc16 $ depth - offset + adjustment)
+            let !var_depth_ws =
+                    trunc16W $ bytesToWords dflags (depth - offset) + 2
+            in Just (id, var_depth_ws)
 
-trunc16 :: Word -> Word16
-trunc16 w
+truncIntegral16 :: Integral a => a -> Word16
+truncIntegral16 w
     | w > fromIntegral (maxBound :: Word16)
     = panic "stack depth overflow"
     | otherwise
     = fromIntegral w
 
+trunc16W :: WordOff -> Word16
+trunc16W = truncIntegral16
+
 fvsToEnv :: BCEnv -> DVarSet -> [Id]
 -- Takes the free variables of a right-hand side, and
 -- delivers an ordered list of the local variables that will
@@ -441,21 +472,26 @@ fvsToEnv p fvs = [v | v <- dVarSetElems fvs,
 -- -----------------------------------------------------------------------------
 -- schemeE
 
-returnUnboxedAtom :: Word -> Sequel -> BCEnv
-                 -> AnnExpr' Id DVarSet -> ArgRep
-                 -> BcM BCInstrList
+returnUnboxedAtom
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> AnnExpr' Id DVarSet
+    -> ArgRep
+    -> BcM BCInstrList
 -- Returning an unlifted value.
 -- Heave it on the stack, SLIDE, and RETURN.
-returnUnboxedAtom d s p e e_rep
-   = do (push, szw) <- pushAtom d p e
-        return (push                       -- value onto stack
-                `appOL`  mkSLIDE szw (d-s) -- clear to sequel
-                `snocOL` RETURN_UBX e_rep) -- go
+returnUnboxedAtom d s p e e_rep = do
+    dflags <- getDynFlags
+    (push, szb) <- pushAtom d p e
+    return (push                                 -- value onto stack
+           `appOL`  mkSlideB dflags szb (d - s)  -- clear to sequel
+           `snocOL` RETURN_UBX e_rep)            -- go
 
 -- Compile code to apply the given expression to the remaining args
 -- on the stack, returning a HNF.
-schemeE :: Word -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
-
+schemeE
+    :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
 schemeE d s p e
    | Just e' <- bcView e
    = schemeE d s p e'
@@ -478,7 +514,8 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
         -- saturated constructor application.
         -- Just allocate the constructor and carry on
         alloc_code <- mkConAppCode d s p data_con args_r_to_l
-        let !d2 = d + 1
+        dflags <- getDynFlags
+        let !d2 = d + wordSize dflags
         body_code <- schemeE d2 s (Map.insert x d2 p) body
         return (alloc_code `appOL` body_code)
 
@@ -493,28 +530,39 @@ schemeE d s p (AnnLet binds (_,body)) = do
          fvss  = map (fvsToEnv p' . fst) rhss
 
          -- Sizes of free vars
-         sizes = map (\rhs_fvs -> sum (map (fromIntegral . idSizeW dflags) rhs_fvs)) fvss
+         size_w = trunc16W . idSizeW dflags
+         sizes = map (\rhs_fvs -> sum (map size_w rhs_fvs)) fvss
 
          -- the arity of each rhs
          arities = map (genericLength . fst . collect) rhss
 
          -- This p', d' defn is safe because all the items being pushed
-         -- are ptrs, so all have size 1.  d' and p' reflect the stack
+         -- are ptrs, so all have size 1 word.  d' and p' reflect the stack
          -- after the closures have been allocated in the heap (but not
          -- filled in), and pointers to them parked on the stack.
-         p'    = Map.insertList (zipE xs (mkStackOffsets d (genericReplicate n_binds 1))) p
-         d'    = d + fromIntegral n_binds
-         zipE  = zipEqual "schemeE"
+         offsets = mkStackOffsets d (genericReplicate n_binds (wordSize dflags))
+         p' = Map.insertList (zipE xs offsets) p
+         d' = d + wordsToBytes dflags n_binds
+         zipE = zipEqual "schemeE"
 
          -- ToDo: don't build thunks for things with no free variables
+         build_thunk
+             :: StackDepth
+             -> [Id]
+             -> Word16
+             -> ProtoBCO Name
+             -> Word16
+             -> Word16
+             -> BcM BCInstrList
          build_thunk _ [] size bco off arity
             = return (PUSH_BCO bco `consOL` unitOL (mkap (off+size) size))
            where
                 mkap | arity == 0 = MKAP
                      | otherwise  = MKPAP
          build_thunk dd (fv:fvs) size bco off arity = do
-              (push_code, pushed_szw) <- pushAtom dd p' (AnnVar fv)
-              more_push_code <- build_thunk (dd + fromIntegral pushed_szw) fvs size bco off arity
+              (push_code, pushed_szb) <- pushAtom dd p' (AnnVar fv)
+              more_push_code <-
+                  build_thunk (dd + pushed_szb) fvs size bco off arity
               return (push_code `appOL` more_push_code)
 
          alloc_code = toOL (zipWith mkAlloc sizes arities)
@@ -532,7 +580,7 @@ schemeE d s p (AnnLet binds (_,body)) = do
                 build_thunk d' fvs size bco off arity
 
          compile_binds =
-            [ compile_bind d' fvs x rhs size arity n
+            [ compile_bind d' fvs x rhs size arity (trunc16W n)
             | (fvs, x, rhs, size, arity, n) <-
                 zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1]
             ]
@@ -661,7 +709,7 @@ schemeE _ _ _ expr
 -- 4.  Otherwise, it must be a function call.  Push the args
 --     right to left, SLIDE and ENTER.
 
-schemeT :: Word         -- Stack depth
+schemeT :: StackDepth   -- Stack depth
         -> Sequel       -- Sequel depth
         -> BCEnv        -- stack env
         -> AnnExpr' Id DVarSet
@@ -669,12 +717,6 @@ schemeT :: Word         -- Stack depth
 
 schemeT d s p app
 
---   | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False
---   = panic "schemeT ?!?!"
-
---   | trace ("\nschemeT\n" ++ showSDoc (pprCoreExpr (deAnnotate' app)) ++ "\n") False
---   = error "?!?!"
-
    -- Case 0
    | Just (arg, constr_names) <- maybe_is_tagToEnum_call app
    = implement_tagToId d s p arg constr_names
@@ -699,8 +741,9 @@ schemeT d s p app
    -- Case 3: Ordinary data constructor
    | Just con <- maybe_saturated_dcon
    = do alloc_con <- mkConAppCode d s p con args_r_to_l
+        dflags <- getDynFlags
         return (alloc_con         `appOL`
-                mkSLIDE 1 (d - s) `snocOL`
+                mkSlideW 1 (bytesToWords dflags $ d - s) `snocOL`
                 ENTER)
 
    -- Case 4: Tail call of function
@@ -725,33 +768,46 @@ schemeT d s p app
 -- Generate code to build a constructor application,
 -- leaving it on top of the stack
 
-mkConAppCode :: Word -> Sequel -> BCEnv
-             -> DataCon                 -- The data constructor
-             -> [AnnExpr' Id DVarSet]    -- Args, in *reverse* order
-             -> BcM BCInstrList
-
+mkConAppCode
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> DataCon                  -- The data constructor
+    -> [AnnExpr' Id DVarSet]    -- Args, in *reverse* order
+    -> BcM BCInstrList
 mkConAppCode _ _ _ con []       -- Nullary constructor
   = ASSERT( isNullaryRepDataCon con )
     return (unitOL (PUSH_G (getName (dataConWorkId con))))
         -- Instead of doing a PACK, which would allocate a fresh
         -- copy of this constructor, use the single shared version.
 
-mkConAppCode orig_d _ p con args_r_to_l
-  = ASSERT( args_r_to_l `lengthIs` dataConRepArity con )
-    do_pushery orig_d (non_ptr_args ++ ptr_args)
- where
-        -- The args are already in reverse order, which is the way PACK
-        -- expects them to be.  We must push the non-ptrs after the ptrs.
-      (ptr_args, non_ptr_args) = partition isPtrAtom args_r_to_l
+mkConAppCode orig_d _ p con args_r_to_l =
+    ASSERT( args_r_to_l `lengthIs` dataConRepArity con ) app_code
+  where
+    app_code = do
+        dflags <- getDynFlags
 
-      do_pushery d (arg:args)
-         = do (push, arg_words) <- pushAtom d p arg
-              more_push_code <- do_pushery (d + fromIntegral arg_words) args
-              return (push `appOL` more_push_code)
-      do_pushery d []
-         = return (unitOL (PACK con n_arg_words))
-         where
-           n_arg_words = trunc16 $ d - orig_d
+        -- The args are initially in reverse order, but mkVirtHeapOffsets
+        -- expects them to be left-to-right.
+        let non_voids =
+                [ NonVoid (prim_rep, arg)
+                | arg <- reverse args_r_to_l
+                , let prim_rep = atomPrimRep arg
+                , not (isVoidRep prim_rep)
+                ]
+            is_thunk = False
+            (_, _, args_offsets) = mkVirtHeapOffsets dflags is_thunk non_voids
+
+            do_pushery !d ((arg, _) : args) = do
+                (push, arg_bytes) <- pushAtom d p (fromNonVoid arg)
+                more_push_code <- do_pushery (d + arg_bytes) args
+                return (push `appOL` more_push_code)
+            do_pushery !d [] = do
+                let !n_arg_words = trunc16W $ bytesToWords dflags (d - orig_d)
+                return (unitOL (PACK con n_arg_words))
+
+        -- Push on the stack in the reverse order.
+        do_pushery orig_d (reverse args_offsets)
 
 
 -- -----------------------------------------------------------------------------
@@ -762,39 +818,41 @@ mkConAppCode orig_d _ p con args_r_to_l
 -- returned, even if it is a pointed type.  We always just return.
 
 unboxedTupleReturn
-        :: Word -> Sequel -> BCEnv
-        -> AnnExpr' Id DVarSet -> BcM BCInstrList
+    :: StackDepth -> Sequel -> BCEnv -> AnnExpr' Id DVarSet -> BcM BCInstrList
 unboxedTupleReturn d s p arg = returnUnboxedAtom d s p arg (atomRep arg)
 
 -- -----------------------------------------------------------------------------
 -- Generate code for a tail-call
 
 doTailCall
-        :: Word -> Sequel -> BCEnv
-        -> Id -> [AnnExpr' Id DVarSet]
-        -> BcM BCInstrList
-doTailCall init_d s p fn args
-  = do_pushes init_d args (map atomRep args)
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> Id
+    -> [AnnExpr' Id DVarSet]
+    -> BcM BCInstrList
+doTailCall init_d s p fn args = do_pushes init_d args (map atomRep args)
   where
-  do_pushes d [] reps = do
+  do_pushes !d [] reps = do
         ASSERT( null reps ) return ()
         (push_fn, sz) <- pushAtom d p (AnnVar fn)
-        ASSERT( sz == 1 ) return ()
-        return (push_fn `appOL` (
-                  mkSLIDE (trunc16 $ d - init_d + 1) (init_d - s) `appOL`
-                  unitOL ENTER))
-  do_pushes d args reps = do
+        dflags <- getDynFlags
+        ASSERT( sz == wordSize dflags ) return ()
+        let slide = mkSlideB dflags (d - init_d + wordSize dflags) (init_d - s)
+        return (push_fn `appOL` (slide `appOL` unitOL ENTER))
+  do_pushes !d args reps = do
       let (push_apply, n, rest_of_reps) = findPushSeq reps
           (these_args, rest_of_args) = splitAt n args
       (next_d, push_code) <- push_seq d these_args
-      instrs <- do_pushes (next_d + 1) rest_of_args rest_of_reps
+      dflags <- getDynFlags
+      instrs <- do_pushes (next_d + wordSize dflags) rest_of_args rest_of_reps
       --                          ^^^ for the PUSH_APPLY_ instruction
       return (push_code `appOL` (push_apply `consOL` instrs))
 
   push_seq d [] = return (d, nilOL)
   push_seq d (arg:args) = do
     (push_code, sz) <- pushAtom d p arg
-    (final_d, more_push_code) <- push_seq (d + fromIntegral sz) args
+    (final_d, more_push_code) <- push_seq (d + sz) args
     return (final_d, push_code `appOL` more_push_code)
 
 -- v. similar to CgStackery.findMatch, ToDo: merge
@@ -827,10 +885,16 @@ findPushSeq _
 -- -----------------------------------------------------------------------------
 -- Case expressions
 
-doCase  :: Word -> Sequel -> BCEnv
-        -> AnnExpr Id DVarSet -> Id -> [AnnAlt Id DVarSet]
-        -> Maybe Id  -- Just x <=> is an unboxed tuple case with scrut binder, don't enter the result
-        -> BcM BCInstrList
+doCase
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> AnnExpr Id DVarSet
+    -> Id
+    -> [AnnAlt Id DVarSet]
+    -> Maybe Id  -- Just x <=> is an unboxed tuple case with scrut binder,
+                 -- don't enter the result
+    -> BcM BCInstrList
 doCase d s p (_,scrut) bndr alts is_unboxed_tuple
   | typePrimRep (idType bndr) `lengthExceeds` 1
   = multiValException
@@ -846,30 +910,31 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
         -- underneath it is the pointer to the alt_code BCO.
         -- When an alt is entered, it assumes the returned value is
         -- on top of the itbl.
-        ret_frame_sizeW :: Word
-        ret_frame_sizeW = 2
+        ret_frame_size_b :: StackDepth
+        ret_frame_size_b = 2 * wordSize dflags
 
         -- The extra frame we push to save/restor the CCCS when profiling
-        save_ccs_sizeW | profiling = 2
-                       | otherwise = 0
+        save_ccs_size_b | profiling = 2 * wordSize dflags
+                        | otherwise = 0
 
         -- An unlifted value gets an extra info table pushed on top
         -- when it is returned.
-        unlifted_itbl_sizeW :: Word
-        unlifted_itbl_sizeW | isAlgCase = 0
-                            | otherwise = 1
+        unlifted_itbl_size_b :: StackDepth
+        unlifted_itbl_size_b | isAlgCase = 0
+                            | otherwise = wordSize dflags
 
         -- depth of stack after the return value has been pushed
-        d_bndr = d + ret_frame_sizeW + fromIntegral (idSizeW dflags bndr)
+        d_bndr = d + ret_frame_size_b + idSizeB dflags bndr
 
         -- depth of stack after the extra info table for an unboxed return
         -- has been pushed, if any.  This is the stack depth at the
         -- continuation.
-        d_alts = d_bndr + unlifted_itbl_sizeW
+        d_alts = d_bndr + unlifted_itbl_size_b
 
         -- Env in which to compile the alts, not including
         -- any vars bound by the alts themselves
         p_alts0 = Map.insert bndr d_bndr p
+
         p_alts = case is_unboxed_tuple of
                    Just ubx_bndr -> Map.insert ubx_bndr d_bndr p_alts0
                    Nothing       -> p_alts0
@@ -889,21 +954,25 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
                 return (my_discr alt, rhs_code)
            -- algebraic alt with some binders
            | otherwise =
-             let
-                 (ptrs,nptrs) = partition (isFollowableArg.bcIdArgRep) real_bndrs
-                 ptr_sizes    = map (fromIntegral . idSizeW dflags) ptrs
-                 nptrs_sizes  = map (fromIntegral . idSizeW dflags) nptrs
-                 bind_sizes   = ptr_sizes ++ nptrs_sizes
-                 size         = sum ptr_sizes + sum nptrs_sizes
-                 -- the UNPACK instruction unpacks in reverse order...
+             let (tot_wds, _ptrs_wds, args_offsets) =
+                     mkVirtConstrOffsets dflags
+                         [ NonVoid (bcIdPrimRep id, id)
+                         | NonVoid id <- nonVoidIds real_bndrs
+                         ]
+                 size = WordOff tot_wds
+
+                 stack_bot = d_alts + wordsToBytes dflags size
+
+                 -- convert offsets from Sp into offsets into the virtual stack
                  p' = Map.insertList
-                        (zip (reverse (ptrs ++ nptrs))
-                          (mkStackOffsets d_alts (reverse bind_sizes)))
+                        [ (arg, stack_bot + wordSize dflags - ByteOff offset)
+                        | (NonVoid arg, offset) <- args_offsets ]
                         p_alts
              in do
              MASSERT(isAlgCase)
-             rhs_code <- schemeE (d_alts + size) s p' rhs
-             return (my_discr alt, unitOL (UNPACK (trunc16 size)) `appOL` rhs_code)
+             rhs_code <- schemeE stack_bot s p' rhs
+             return (my_discr alt,
+                     unitOL (UNPACK (trunc16W size)) `appOL` rhs_code)
            where
              real_bndrs = filterOut isTyVar bndrs
 
@@ -942,7 +1011,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
         -- really want a bitmap up to depth (d-s).  This affects compilation of
         -- case-of-case expressions, which is the only time we can be compiling a
         -- case expression with s /= 0.
-        bitmap_size = trunc16 $ d-s
+        bitmap_size = trunc16W $ bytesToWords dflags (d - s)
         bitmap_size' :: Int
         bitmap_size' = fromIntegral bitmap_size
         bitmap = intsToReverseBitmap dflags bitmap_size'{-size-}
@@ -954,7 +1023,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
           rel_slots = nub $ map fromIntegral $ concat (map spread binds)
           spread (id, offset) | isFollowableArg (bcIdArgRep id) = [ rel_offset ]
                               | otherwise                      = []
-                where rel_offset = trunc16 $ d - fromIntegral offset
+                where rel_offset = trunc16W $ bytesToWords dflags (d - offset)
 
      alt_stuff <- mapM codeAlt alts
      alt_final <- mkMultiBranch maybe_ncons alt_stuff
@@ -966,8 +1035,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 --     trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++
 --            "\n      bitmap = " ++ show bitmap) $ do
 
-     scrut_code <- schemeE (d + ret_frame_sizeW + save_ccs_sizeW)
-                           (d + ret_frame_sizeW + save_ccs_sizeW)
+     scrut_code <- schemeE (d + ret_frame_size_b + save_ccs_size_b)
+                           (d + ret_frame_size_b + save_ccs_size_b)
                            p scrut
      alt_bco' <- emitBc alt_bco
      let push_alts
@@ -985,27 +1054,30 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 -- (machine) code for the ccall, and create bytecodes to call that and
 -- then return in the right way.
 
-generateCCall :: Word -> Sequel         -- stack and sequel depths
-              -> BCEnv
-              -> CCallSpec              -- where to call
-              -> Id                     -- of target, for type info
-              -> [AnnExpr' Id DVarSet]   -- args (atoms)
-              -> BcM BCInstrList
-
+generateCCall
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> CCallSpec               -- where to call
+    -> Id                      -- of target, for type info
+    -> [AnnExpr' Id DVarSet]   -- args (atoms)
+    -> BcM BCInstrList
 generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
  = do
      dflags <- getDynFlags
 
      let
          -- useful constants
-         addr_sizeW :: Word16
-         addr_sizeW = fromIntegral (argRepSizeW dflags N)
+         addr_size_b :: ByteOff
+         addr_size_b = wordSize dflags
 
          -- Get the args on the stack, with tags and suitably
          -- dereferenced for the CCall.  For each arg, return the
          -- depth to the first word of the bits for that arg, and the
          -- ArgRep of what was actually pushed.
 
+         pargs
+             :: ByteOff -> [AnnExpr' Id DVarSet] -> BcM [(BCInstrList, PrimRep)]
          pargs _ [] = return []
          pargs d (a:az)
             = let arg_ty = unwrapType (exprType (deAnnotate' a))
@@ -1015,31 +1087,35 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                     -- contains.
                     Just t
                      | t == arrayPrimTyCon || t == mutableArrayPrimTyCon
-                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
+                       -> do rest <- pargs (d + addr_size_b) az
                              code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
                      | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon
-                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
+                       -> do rest <- pargs (d + addr_size_b) az
                              code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
                      | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
-                       -> do rest <- pargs (d + fromIntegral addr_sizeW) az
+                       -> do rest <- pargs (d + addr_size_b) az
                              code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a
                              return ((code,AddrRep):rest)
 
                     -- Default case: push taggedly, but otherwise intact.
                     _
                        -> do (code_a, sz_a) <- pushAtom d p a
-                             rest <- pargs (d + fromIntegral sz_a) az
+                             rest <- pargs (d + sz_a) az
                              return ((code_a, atomPrimRep a) : rest)
 
          -- Do magic for Ptr/Byte arrays.  Push a ptr to the array on
          -- the stack but then advance it over the headers, so as to
          -- point to the payload.
-         parg_ArrayishRep :: Word16 -> Word -> BCEnv -> AnnExpr' Id DVarSet
-                          -> BcM BCInstrList
+         parg_ArrayishRep
+             :: Word16
+             -> StackDepth
+             -> BCEnv
+             -> AnnExpr' Id DVarSet
+             -> BcM BCInstrList
          parg_ArrayishRep hdrSize d p a
             = do (push_fo, _) <- pushAtom d p a
                  -- The ptr points at the header.  Advance it over the
@@ -1049,10 +1125,11 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
      code_n_reps <- pargs d0 args_r_to_l
      let
          (pushs_arg, a_reps_pushed_r_to_l) = unzip code_n_reps
-         a_reps_sizeW = fromIntegral (sum (map (primRepSizeW dflags) a_reps_pushed_r_to_l))
+         a_reps_sizeW =
+             WordOff (sum (map (primRepSizeW dflags) a_reps_pushed_r_to_l))
 
          push_args    = concatOL pushs_arg
-         d_after_args = d0 + a_reps_sizeW
+         !d_after_args = d0 + wordsToBytes dflags a_reps_sizeW
          a_reps_pushed_RAW
             | null a_reps_pushed_r_to_l || head a_reps_pushed_r_to_l /= VoidRep
             = panic "ByteCodeGen.generateCCall: missing or invalid World token?"
@@ -1104,6 +1181,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
             void marshall_code ( StgWord* ptr_to_top_of_stack )
          -}
          -- resolve static address
+         maybe_static_target :: Maybe Literal
          maybe_static_target =
              case target of
                  DynamicTarget -> Nothing
@@ -1132,18 +1210,18 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
          -- push the Addr#
          (push_Addr, d_after_Addr)
             | Just machlabel <- maybe_static_target
-            = (toOL [PUSH_UBX machlabel addr_sizeW],
-               d_after_args + fromIntegral addr_sizeW)
+            = (toOL [PUSH_UBX machlabel 1], d_after_args + addr_size_b)
             | otherwise -- is already on the stack
             = (nilOL, d_after_args)
 
          -- Push the return placeholder.  For a call returning nothing,
          -- this is a V (tag).
-         r_sizeW   = fromIntegral (primRepSizeW dflags r_rep)
-         d_after_r = d_after_Addr + fromIntegral r_sizeW
-         push_r    = (if   returns_void
-                      then nilOL
-                      else unitOL (PUSH_UBX (mkDummyLiteral r_rep) r_sizeW))
+         r_sizeW   = WordOff (primRepSizeW dflags r_rep)
+         d_after_r = d_after_Addr + wordsToBytes dflags r_sizeW
+         push_r =
+             if returns_void
+                then nilOL
+                else unitOL (PUSH_UBX (mkDummyLiteral r_rep) (trunc16W r_sizeW))
 
          -- generate the marshalling code we're going to call
 
@@ -1151,7 +1229,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
          -- instruction needs to describe the chunk of stack containing
          -- the ccall args to the GC, so it needs to know how large it
          -- is.  See comment in Interpreter.c with the CCALL instruction.
-         stk_offset   = trunc16 $ d_after_r - s
+         stk_offset   = trunc16W $ bytesToWords dflags (d_after_r - s)
 
          conv = case cconv of
            CCallConv -> FFICCall
@@ -1178,7 +1256,8 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                            PlayRisky         -> 0x2
 
          -- slide and return
-         wrapup       = mkSLIDE r_sizeW (d_after_r - fromIntegral r_sizeW - s)
+         d_after_r_min_s = bytesToWords dflags (d_after_r - s)
+         wrapup       = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW)
                         `snocOL` RETURN_UBX (toArgRep r_rep)
          --trace (show (arg1_offW, args_offW  ,  (map argRepSizeW a_reps) )) $
      return (
@@ -1311,18 +1390,25 @@ a 1-word null. See Trac #8383.
 -}
 
 
-implement_tagToId :: Word -> Sequel -> BCEnv
-                  -> AnnExpr' Id DVarSet -> [Name] -> BcM BCInstrList
+implement_tagToId
+    :: StackDepth
+    -> Sequel
+    -> BCEnv
+    -> AnnExpr' Id DVarSet
+    -> [Name]
+    -> BcM BCInstrList
 -- See Note [Implementing tagToEnum#]
 implement_tagToId d s p arg names
   = ASSERT( notNull names )
-    do (push_arg, arg_words) <- pushAtom d p arg
+    do (push_arg, arg_bytes) <- pushAtom d p arg
        labels <- getLabelsBc (genericLength names)
        label_fail <- getLabelBc
        label_exit <- getLabelBc
+       dflags <- getDynFlags
        let infos = zip4 labels (tail labels ++ [label_fail])
                                [0 ..] names
            steps = map (mkStep label_exit) infos
+           slide_ws = bytesToWords dflags (d - s + arg_bytes)
 
        return (push_arg
                `appOL` unitOL (PUSH_UBX MachNullAddr 1)
@@ -1330,10 +1416,10 @@ implement_tagToId d s p arg names
                `appOL` concatOL steps
                `appOL` toOL [ LABEL label_fail, CASEFAIL,
                               LABEL label_exit ]
-                `appOL` mkSLIDE 1 (d - s + fromIntegral arg_words + 1)
+               `appOL` mkSlideW 1 (slide_ws + 1)
                    -- "+1" to account for bogus word
                    --      (see Note [Implementing tagToEnum#])
-                `appOL` unitOL ENTER)
+               `appOL` unitOL ENTER)
   where
         mkStep l_exit (my_label, next_label, n, name_for_n)
            = toOL [LABEL my_label,
@@ -1355,8 +1441,8 @@ implement_tagToId d s p arg names
 -- to 5 and not to 4.  Stack locations are numbered from zero, so a
 -- depth 6 stack has valid words 0 .. 5.
 
-pushAtom :: Word -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, Word16)
-
+pushAtom
+    :: StackDepth -> BCEnv -> AnnExpr' Id DVarSet -> BcM (BCInstrList, ByteOff)
 pushAtom d p e
    | Just e' <- bcView e
    = pushAtom d p e'
@@ -1370,22 +1456,26 @@ pushAtom _ _ (AnnCoercion {})   -- Coercions are zero-width things,
 pushAtom d p (AnnCase (_, a) _ _ []) -- trac #12128
    = pushAtom d p a
 
-pushAtom d p (AnnVar v)
-   | [] <- typePrimRep (idType v)
+pushAtom d p (AnnVar var)
+   | [] <- typePrimRep (idType var)
    = return (nilOL, 0)
 
-   | isFCallId v
-   = pprPanic "pushAtom: shouldn't get an FCallId here" (ppr v)
+   | isFCallId var
+   = pprPanic "pushAtom: shouldn't get an FCallId here" (ppr var)
 
-   | Just primop <- isPrimOpId_maybe v
-   = return (unitOL (PUSH_PRIMOP primop), 1)
+   | Just primop <- isPrimOpId_maybe var
+   = do
+       dflags <-getDynFlags
+       return (unitOL (PUSH_PRIMOP primop), wordSize dflags)
 
-   | Just d_v <- lookupBCEnv_maybe v p  -- v is a local variable
+   | Just d_v <- lookupBCEnv_maybe var p  -- var is a local variable
    = do dflags <- getDynFlags
-        let sz :: Word16
-            sz = fromIntegral (idSizeW dflags v)
-            l = trunc16 $ d - d_v + fromIntegral sz - 1
-        return (toOL (genericReplicate sz (PUSH_L l)), sz)
+        -- Currently this code assumes that @szb@ is a multiple of full words.
+        -- It'll need to change to support, e.g., sub-word constructor fields.
+        let !szb = idSizeB dflags var
+            !szw = bytesToWords dflags szb -- szb is a multiple of words
+            l = trunc16W $ bytesToWords dflags (d - d_v) + szw - 1
+        return (toOL (genericReplicate szw (PUSH_L l)), szb)
         -- d - d_v           offset from TOS to the first slot of the object
         --
         -- d - d_v + sz - 1  offset from the TOS of the last slot of the object
@@ -1393,25 +1483,24 @@ pushAtom d p (AnnVar v)
         -- Having found the last slot, we proceed to copy the right number of
         -- slots on to the top of the stack.
 
-   | otherwise  -- v must be a global variable
+   | otherwise  -- var must be a global variable
    = do topStrings <- getTopStrings
-        case lookupVarEnv topStrings v of
+        case lookupVarEnv topStrings var of
             Just ptr -> pushAtom d p $ AnnLit $ MachWord $ fromIntegral $
               ptrToWordPtr $ fromRemotePtr ptr
             Nothing -> do
                 dflags <- getDynFlags
-                let sz :: Word16
-                    sz = fromIntegral (idSizeW dflags v)
-                MASSERT(sz == 1)
-                return (unitOL (PUSH_G (getName v)), sz)
+                let sz = idSizeB dflags var
+                MASSERT( sz == wordSize dflags )
+                return (unitOL (PUSH_G (getName var)), sz)
 
 
 pushAtom _ _ (AnnLit lit) = do
      dflags <- getDynFlags
      let code rep
-             = let size_host_words = fromIntegral (argRepSizeW dflags rep)
-               in  return (unitOL (PUSH_UBX lit size_host_words),
-                           size_host_words)
+             = let size_words = WordOff (argRepSizeW dflags rep)
+               in  return (unitOL (PUSH_UBX lit (trunc16W size_words)),
+                           wordsToBytes dflags size_words)
 
      case lit of
         MachLabel _ _ _ -> code N
@@ -1572,11 +1661,14 @@ instance Outputable Discr where
    ppr NoDiscr    = text "DEF"
 
 
-lookupBCEnv_maybe :: Id -> BCEnv -> Maybe Word
+lookupBCEnv_maybe :: Id -> BCEnv -> Maybe ByteOff
 lookupBCEnv_maybe = Map.lookup
 
-idSizeW :: DynFlags -> Id -> Int
-idSizeW dflags = argRepSizeW dflags . bcIdArgRep
+idSizeW :: DynFlags -> Id -> WordOff
+idSizeW dflags = WordOff . argRepSizeW dflags . bcIdArgRep
+
+idSizeB :: DynFlags -> Id -> ByteOff
+idSizeB dflags = wordsToBytes dflags . idSizeW dflags
 
 bcIdArgRep :: Id -> ArgRep
 bcIdArgRep = toArgRep . bcIdPrimRep
@@ -1618,19 +1710,25 @@ unsupportedCConvException = throwGhcException (ProgramError
   ("Error: bytecode compiler can't handle some foreign calling conventions\n"++
    "  Workaround: use -fobject-code, or compile this module to .o separately."))
 
-mkSLIDE :: Word16 -> Word -> OrdList BCInstr
-mkSLIDE n d
-    -- if the amount to slide doesn't fit in a word,
-    -- generate multiple slide instructions
-    | d > fromIntegral limit
-    = SLIDE n limit `consOL` mkSLIDE n (d - fromIntegral limit)
-    | d == 0
+mkSlideB :: DynFlags -> ByteOff -> ByteOff -> OrdList BCInstr
+mkSlideB dflags !nb !db = mkSlideW n d
+  where
+    !n = trunc16W $ bytesToWords dflags nb
+    !d = bytesToWords dflags db
+
+mkSlideW :: Word16 -> WordOff -> OrdList BCInstr
+mkSlideW !n !ws
+    | ws > fromIntegral limit
+    -- If the amount to slide doesn't fit in a Word16, generate multiple slide
+    -- instructions
+    = SLIDE n limit `consOL` mkSlideW n (ws - fromIntegral limit)
+    | ws == 0
     = nilOL
     | otherwise
-    = if d == 0 then nilOL else unitOL (SLIDE n $ fromIntegral d)
-    where
-        limit :: Word16
-        limit = maxBound
+    = unitOL (SLIDE n $ fromIntegral ws)
+  where
+    limit :: Word16
+    limit = maxBound
 
 splitApp :: AnnExpr' Var ann -> (AnnExpr' Var ann, [AnnExpr' Var ann])
         -- The arguments are returned in *right-to-left* order
@@ -1676,14 +1774,11 @@ atomPrimRep other = pprPanic "atomPrimRep" (ppr (deAnnotate' other))
 atomRep :: AnnExpr' Id ann -> ArgRep
 atomRep e = toArgRep (atomPrimRep e)
 
-isPtrAtom :: AnnExpr' Id ann -> Bool
-isPtrAtom e = isFollowableArg (atomRep e)
-
--- | Let szsw be the sizes in words of some items pushed onto the stack, which
+-- | Let szsw be the sizes in bytes of some items pushed onto the stack, which
 -- has initial depth @original_depth@.  Return the values which the stack
 -- environment should map these items to.
-mkStackOffsets :: Word -> [Word] -> [Word]
-mkStackOffsets original_depth szsw = tail (scanl' (+) original_depth szsw)
+mkStackOffsets :: ByteOff -> [ByteOff] -> [ByteOff]
+mkStackOffsets original_depth szsb = tail (scanl' (+) original_depth szsb)
 
 typeArgRep :: Type -> ArgRep
 typeArgRep = toArgRep . typePrimRep1
diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs
index 525280290f..fabde4e52d 100644
--- a/compiler/ghci/ByteCodeInstr.hs
+++ b/compiler/ghci/ByteCodeInstr.hs
@@ -30,11 +30,7 @@ import PrimOp
 import SMRep
 
 import Data.Word
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS (CostCentre)
-#else
-import GHC.Stack (CostCentre)
-#endif
 
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs
index 1318a47ef4..4b78600f70 100644
--- a/compiler/ghci/ByteCodeTypes.hs
+++ b/compiler/ghci/ByteCodeTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -34,11 +34,7 @@ import Data.Array.Base  ( UArray(..) )
 import Data.ByteString (ByteString)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
-#else
-import GHC.Stack as GHC.Stack.CCS
-#endif
 
 -- -----------------------------------------------------------------------------
 -- Compiled Byte Code
diff --git a/compiler/ghci/GHCi.hsc b/compiler/ghci/GHCi.hs
index d2f2f5a833..403cffdc70 100644
--- a/compiler/ghci/GHCi.hsc
+++ b/compiler/ghci/GHCi.hs
@@ -75,23 +75,13 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.IORef
 import Foreign hiding (void)
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS (CostCentre,CostCentreStack)
-#else
-import GHC.Stack (CostCentre,CostCentreStack)
-#endif
 import System.Exit
 import Data.Maybe
 import GHC.IO.Handle.Types (Handle)
 #if defined(mingw32_HOST_OS)
 import Foreign.C
 import GHC.IO.Handle.FD (fdToHandle)
-#if !MIN_VERSION_process(1,4,2)
-import System.Posix.Internals
-import Foreign.Marshal.Array
-import Foreign.C.Error
-import Foreign.Storable
-#endif
 #else
 import System.Posix as Posix
 #endif
@@ -545,22 +535,6 @@ runWithPipes createProc prog opts = do
       where mkHandle :: CInt -> IO Handle
             mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
 
-#if !MIN_VERSION_process(1,4,2)
--- This #include and the _O_BINARY below are the only reason this is hsc,
--- so we can remove that once we can depend on process 1.4.2
-#include <fcntl.h>
-
-createPipeFd :: IO (FD, FD)
-createPipeFd = do
-    allocaArray 2 $ \ pfds -> do
-        throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY)
-        readfd <- peek pfds
-        writefd <- peekElemOff pfds 1
-        return (readfd, writefd)
-
-foreign import ccall "io.h _pipe" c__pipe ::
-    Ptr CInt -> CUInt -> CInt -> IO CInt
-#endif
 #else
 runWithPipes createProc prog opts = do
     (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index aee7684157..d174cc089d 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -722,15 +722,6 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
             adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
             adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp)
             adjust_ul _ l@(BCOs {}) = return l
-#if !MIN_VERSION_filepath(1,4,1)
-    stripExtension :: String -> FilePath -> Maybe FilePath
-    stripExtension []        path = Just path
-    stripExtension ext@(x:_) path = stripSuffix dotExt path
-        where dotExt = if isExtSeparator x then ext else '.':ext
-
-    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
-    stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
-#endif
 
 
 
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 785513b3b6..263aeba7e9 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -637,7 +637,7 @@ addConstraint actual expected = do
       discardResult $
       captureConstraints $
       do { (ty1, ty2) <- congruenceNewtypes actual expected
-         ; unifyType noThing ty1 ty2 }
+         ; unifyType Nothing ty1 ty2 }
      -- TOMDO: what about the coercion?
      -- we should consider family instances
 
@@ -1186,7 +1186,7 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
                (_, vars) <- instTyVars (tyConTyVars new_tycon)
                let ty' = mkTyConApp new_tycon (mkTyVarTys vars)
                    rep_ty = unwrapType ty'
-               _ <- liftTcM (unifyType noThing ty rep_ty)
+               _ <- liftTcM (unifyType Nothing ty rep_ty)
         -- assumes that reptype doesn't ^^^^ touch tyconApp args
                return ty'
 
diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs
index f2b562d2d1..20ee4d2a5d 100644
--- a/compiler/hsSyn/HsBinds.hs
+++ b/compiler/hsSyn/HsBinds.hs
@@ -278,7 +278,7 @@ pattern
   --
   -- The pattern is never a simple variable;
   -- That case is done by FunBind.
-  -- See Note [Varieties of binding pattern matches] for details about the
+  -- See Note [FunBind vs PatBind] for details about the
   -- relationship between FunBind and PatBind.
 
   --
@@ -315,22 +315,9 @@ pattern
     -- Note [Typechecking plan for instance declarations]
     (LHsBinds pass) ->
     -- ^ Typechecked user bindings
+    Bool -> -- See Note [The abs_sig field of AbsBinds]    
     HsBindLR pass pass'
   -- ^ Abstraction Bindings
-pattern
-  AbsBindsSig ::
-    -- Simpler form of AbsBinds, used with a type sig
-    -- in tcPolyCheck. Produces simpler desugaring and
-    -- is necessary to avoid #11405, comment:3.
-    ([TyVar]) ->
-    ([EvVar]) ->
-    (IdP pass) ->     -- like abe_poly
-    (TcSpecPrags) ->
-    (TcEvBinds) ->    -- no list needed here
-    (LHsBind pass) -> -- always only one, and it's always a
-                      -- FunBind
-    HsBindLR pass pass'
-  -- | ^ Abstraction Bindings Signature
 
 pattern
   PatSynBind ::
@@ -369,15 +356,11 @@ pattern
     = AST.VarBind NoFieldExt var_id var_rhs var_inline
 pattern
   AbsBinds { abs_tvsa, abs_ev_varsa, abs_exports, abs_ev_binds,
-             abs_binds } -- abs_tvs --> abs_tvsa
-    = AST.NewBindLR
-        (NAbsBinds abs_tvsa abs_ev_varsa abs_exports abs_ev_binds abs_binds)
-pattern
-  AbsBindsSig { abs_tvs, abs_ev_vars, abs_sig_export, abs_sig_prags,
-                abs_sig_ev_bind, abs_sig_bind }
+             abs_binds, abs_sig } -- abs_tvs --> abs_tvsa
     = AST.NewBindLR
-        (NAbsBindsSig abs_tvs abs_ev_vars abs_sig_export abs_sig_prags
-                abs_sig_ev_bind abs_sig_bind)
+        (NAbsBinds abs_tvsa abs_ev_varsa abs_exports abs_ev_binds abs_binds
+                   abs_sig)
+
 pattern
   PatSynBind a
     = AST.PatSynBind NoFieldExt a
@@ -393,7 +376,6 @@ get_bind_fvs _           = error "field selector applied to a wrong constructor"
     PatBind,
     VarBind,
     AbsBinds,
-    AbsBindsSig,
     PatSynBind
   #-}
 
@@ -420,14 +402,8 @@ data NewHsBindLR pass pass'
       [ABExport pass]
       [TcEvBinds]
       (LHsBinds pass)
+      Bool
 
-  | NAbsBindsSig
-      [TyVar]
-      [EvVar]
-      (IdP pass)
-      TcSpecPrags
-      TcEvBinds
-      (LHsBind pass)
 
 -- | Located Haskell Binding with separate Left and Right identifier types
 type
@@ -438,7 +414,7 @@ type
 
 -- | Abtraction Bindings Export
 data ABExport p
-  = ABE { abe_poly      :: IdP p -- ^ Any INLINE pragmas is attached to this Id
+  = ABE { abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id
         , abe_mono      :: IdP p
         , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
              -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
@@ -1281,21 +1257,6 @@ ppr_monobind (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = dictvars
       , text "Evidence:" <+> ppr ev_binds ]
     else
       pprLHsBinds val_binds
-ppr_monobind (AbsBindsSig { abs_tvs         = tyvars
-                          , abs_ev_vars     = dictvars
-                          , abs_sig_export  = poly_id
-                          , abs_sig_ev_bind = ev_bind
-                          , abs_sig_bind    = bind })
-  = sdocWithDynFlags $ \ dflags ->
-    if gopt Opt_PrintTypecheckerElaboration dflags then
-      hang (text "AbsBindsSig" <+> brackets (interpp'SP tyvars)
-                               <+> brackets (interpp'SP dictvars))
-         2 $ braces $ vcat
-      [ text "Exported type:" <+> pprBndr LetBind poly_id
-      , text "Bind:"     <+> ppr bind
-      , text "Evidence:" <+> ppr ev_bind ]
-    else
-      ppr bind
 
 instance (OutputableBndrId p) => Outputable (ABExport p) where
   ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
@@ -1449,9 +1410,8 @@ pprMinimalSig (L _ bf) = ppr (fmap unLoc bf)
 -- Notes
 -- -----------------------------------------------------------------------------
 {-
-Note [Varieties of binding pattern matches]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
+Note [FunBind vs PatBind]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~
 The distinction between FunBind and PatBind is a bit subtle. FunBind covers
 patterns which resemble function bindings and simple variable bindings.
 
@@ -1462,12 +1422,17 @@ patterns which resemble function bindings and simple variable bindings.
     x `f` y = e     -- FunRhs has Infix
 
 The actual patterns and RHSs of a FunBind are encoding in fun_matches.
-The m_ctxt field of Match will be FunRhs and carries two bits of information
-about the match,
+The m_ctxt field of each Match in fun_matches will be FunRhs and carries
+two bits of information about the match,
+
+  * The mc_fixity field on each Match describes the fixity of the
+    function binder in that match.  E.g. this is legal:
+         f True False  = e1
+         True `f` True = e2
 
-  * the mc_strictness field describes whether the match is decorated with a bang
-    (e.g. `!x = e`)
-  * the mc_fixity field describes the fixity of the function binder
+  * The mc_strictness field is used /only/ for nullary FunBinds: ones
+    with one Match, which has no pats. For these, it describes whether
+    the match is decorated with a bang (e.g. `!x = e`).
 
 By contrast, PatBind represents data constructor patterns, as well as a few
 other interesting cases. Namely,
@@ -1618,6 +1583,52 @@ bindings only when
    lacks a user type signature
  * The group forms a strongly connected component
 
+Note [The abs_sig field of AbsBinds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The abs_sig field supports a couple of special cases for bindings.
+Consider
+
+  x :: Num a => (# a, a #)
+  x = (# 3, 4 #)
+
+The general desugaring for AbsBinds would give
+
+  x = /\a. \ ($dNum :: Num a) ->
+      letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
+      xm
+
+But that has an illegal let-binding for an unboxed tuple.  In this
+case we'd prefer to generate the (more direct)
+
+  x = /\ a. \ ($dNum :: Num a) ->
+     (# fromInteger $dNum 3, fromInteger $dNum 4 #)
+
+A similar thing happens with representation-polymorphic defns
+(Trac #11405):
+
+  undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
+  undef = error "undef"
+
+Again, the vanilla desugaring gives a local let-binding for a
+representation-polymorphic (undefm :: a), which is illegal.  But
+again we can desugar without a let:
+
+  undef = /\ a. \ (d:HasCallStack) -> error a d "undef"
+
+The abs_sig field supports this direct desugaring, with no local
+let-bining.  When abs_sig = True
+
+ * the abs_binds is single FunBind
+
+ * the abs_exports is a singleton
+
+ * we have a complete type sig for binder
+   and hence the abs_binds is non-recursive
+   (it binds the mono_id but refers to the poly_id
+
+These properties are exploited in DsBinds.dsAbsBinds to
+generate code without a let-binding.
+
 Note [ABExport wrapper]
 ~~~~~~~~~~~~~~~~~~~~~~~
 Consider
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index 5598207a4c..e9e888a76b 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -2826,7 +2826,7 @@ ppr_fam_inst_eqn (L _ (TyFamEqn { tfe_tycon = tycon
                                 , tfe_pats  = pats
                                 , tfe_fixity = fixity
                                 , tfe_rhs   = rhs }))
-    = pp_fam_inst_lhs tycon pats fixity [] <+> equals <+> ppr rhs
+    = pprFamInstLHS tycon pats fixity [] Nothing <+> equals <+> ppr rhs
 
 ppr_fam_deflt_eqn :: (SourceTextX pass, OutputableBndrId pass)
                   => LTyFamDefltEqn pass -> SDoc
@@ -2850,21 +2850,22 @@ pprDataFamInstDecl top_lvl (DataFamInstDecl { dfid_tycon = tycon
   = pp_data_defn pp_hdr defn
   where
     pp_hdr ctxt = ppr_instance_keyword top_lvl
-              <+> pp_fam_inst_lhs tycon pats fixity ctxt
+              <+> pprFamInstLHS tycon pats fixity ctxt (dd_kindSig defn)
 
 pprDataFamInstFlavour :: DataFamInstDecl pass -> SDoc
 pprDataFamInstFlavour (DataFamInstDecl { dfid_defn = (HsDataDefn { dd_ND = nd }) })
   = ppr nd
 
-pp_fam_inst_lhs :: (SourceTextX pass, OutputableBndrId pass)
+pprFamInstLHS :: (SourceTextX pass, OutputableBndrId pass)
    => LIdP pass
    -> HsTyPats pass
    -> LexicalFixity
    -> HsContext pass
+   -> Maybe (LHsKind pass)
    -> SDoc
-pp_fam_inst_lhs thing (HsIB { hsib_body = typats }) fixity context
+pprFamInstLHS thing (HsIB { hsib_body = typats }) fixity context mb_kind_sig
                                               -- explicit type patterns
-   = hsep [ pprHsContext context, pp_pats typats]
+   = hsep [ pprHsContext context, pp_pats typats, pp_kind_sig ]
    where
      pp_pats (patl:patsr)
        | fixity == Infix
@@ -2872,7 +2873,13 @@ pp_fam_inst_lhs thing (HsIB { hsib_body = typats }) fixity context
           , hsep (map (pprHsType.unLoc) patsr)]
        | otherwise = hsep [ pprPrefixOcc (unLoc thing)
                    , hsep (map (pprHsType.unLoc) (patl:patsr))]
-     pp_pats [] = empty
+     pp_pats [] = pprPrefixOcc (unLoc thing)
+
+     pp_kind_sig
+       | Just k <- mb_kind_sig
+       = dcolon <+> ppr k
+       | otherwise
+       = empty
 
 instance (SourceTextX pass, OutputableBndrId pass)
        => Outputable (ClsInstDecl pass) where
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index f6e96dd4c1..fadde4ea0a 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -2486,7 +2486,7 @@ matchGroupArity (MG { mg_alts = alts })
   | otherwise        = panic "matchGroupArity"
 
 hsLMatchPats :: LMatch id body -> [LPat id]
-hsLMatchPats (L _ (Match _ pats _ _)) = pats
+hsLMatchPats (L _ (Match { m_pats = pats })) = pats
 
 -- ------------------------------------
 
diff --git a/compiler/hsSyn/HsLit.hs b/compiler/hsSyn/HsLit.hs
index 9bf5467a00..d2f29ed166 100644
--- a/compiler/hsSyn/HsLit.hs
+++ b/compiler/hsSyn/HsLit.hs
@@ -282,7 +282,7 @@ deriving instance
   (DataId x) => Data (HsLit x)
 
 deriving instance
-  (DataId p, DataId p) => Data (HsOverLit p)
+  (DataId p) => Data (HsOverLit p)
 
 deriving instance
   Data OverLitVal
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 40a8bbd434..4188b3cd34 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -81,7 +81,6 @@ module HsPat
   , mkNilPat
   , looksLazyPatBind
   , isBangedLPat
-  , isBangedPatBind
   , hsPatNeedsParens
   , isIrrefutableHsPat
   , collectEvVarsPats
@@ -729,10 +728,6 @@ patterns are treated specially, of course.
 The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
 -}
 
-isBangedPatBind :: HsBind p -> Bool
-isBangedPatBind (PatBind {pat_lhs = pat}) = isBangedLPat pat
-isBangedPatBind _ = False
-
 isBangedLPat :: LPat p -> Bool
 isBangedLPat (L _ (ParPat p))   = isBangedLPat p
 isBangedLPat (L _ (BangPat {})) = True
@@ -748,8 +743,6 @@ looksLazyPatBind (PatBind { pat_lhs = p })
   = looksLazyLPat p
 looksLazyPatBind (AbsBinds { abs_binds = binds })
   = anyBag (looksLazyPatBind . unLoc) binds
-looksLazyPatBind (AbsBindsSig { abs_sig_bind = L _ bind })
-  = looksLazyPatBind bind
 looksLazyPatBind _
   = False
 
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 5f3a94920b..8588f3d4be 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -72,7 +72,7 @@ module HsUtils(
   noRebindableInfo,
 
   -- Collecting binders
-  isUnliftedHsBind, isBangedBind,
+  isUnliftedHsBind, isBangedHsBind,
 
   collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
   collectHsIdBinders,
@@ -146,7 +146,8 @@ mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP id))
               -> LMatch id (Located (body (GHC id)))
 mkSimpleMatch ctxt pats rhs
   = L loc $
-    Match ctxt pats Nothing (unguardedGRHSs rhs)
+    Match { m_ctxt = ctxt, m_pats = pats, m_type = Nothing
+          , m_grhss = unguardedGRHSs rhs }
   where
     loc = case pats of
                 []      -> getLoc rhs
@@ -758,14 +759,18 @@ mk_easy_FunBind loc fun pats expr
 
 -- | Make a prefix, non-strict function 'HsMatchContext'
 mkPrefixFunRhs :: Located id -> HsMatchContext id
-mkPrefixFunRhs n = FunRhs n Prefix NoSrcStrict
+mkPrefixFunRhs n = FunRhs { mc_fun = n
+                          , mc_fixity = Prefix
+                          , mc_strictness = NoSrcStrict }
 
 ------------
 mkMatch :: HsMatchContext (NameOrRdrName (IdP p)) -> [LPat p] -> LHsExpr p
         -> Located (HsLocalBinds p) -> LMatch p (LHsExpr p)
 mkMatch ctxt pats expr lbinds
-  = noLoc (Match ctxt (map paren pats) Nothing
-                 (GRHSs (unguardedRHS noSrcSpan expr) lbinds))
+  = noLoc (Match { m_ctxt  = ctxt
+                 , m_pats  = map paren pats
+                 , m_type  = Nothing
+                 , m_grhss = GRHSs (unguardedRHS noSrcSpan expr) lbinds })
   where
     paren lp@(L l p) | hsPatNeedsParens p = L l (ParPat lp)
                      | otherwise          = lp
@@ -794,49 +799,31 @@ to return a [Name] or [Id].  Before renaming the record punning
 and wild-card mechanism makes it hard to know what is bound.
 So these functions should not be applied to (HsSyn RdrName)
 
-Note [Unlifted id check in isHsUnliftedBind]
+Note [Unlifted id check in isUnliftedHsBind]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose there is a binding with the type (Num a => (# a, a #)). Is this a
-strict binding that should be disallowed at the top level? At first glance,
-no, because it's a function. But consider how this is desugared via
-AbsBinds:
+The function isUnliftedHsBind is used to complain if we make a top-level
+binding for a variable of unlifted type.
 
-  -- x :: Num a => (# a, a #)
-  x = (# 3, 4 #)
+Such a binding is illegal if the top-level binding would be unlifted;
+but also if the local letrec generated by desugaring AbsBinds would be.
+E.g.
+      f :: Num a => (# a, a #)
+      g :: Num a => a -> a
+      f = ...g...
+      g = ...g...
 
-becomes
+The top-level bindings for f,g are not unlifted (because of the Num a =>),
+but the local, recursive, monomorphic bindings are:
 
-  x = \ $dictNum ->
-      let x_mono = (# fromInteger $dictNum 3, fromInteger $dictNum 4 #) in
-      x_mono
+      t = /\a \(d:Num a).
+         letrec fm :: (# a, a #) = ...g...
+                gm :: a -> a = ...f...
+         in (fm, gm)
 
-Note that the inner let is strict. And thus if we have a bunch of mutually
-recursive bindings of this form, we could end up in trouble. This was shown
-up in #9140.
-
-But if there is a type signature on x, everything changes because of the
-desugaring used by AbsBindsSig:
-
-  x :: Num a => (# a, a #)
-  x = (# 3, 4 #)
-
-becomes
-
-  x = \ $dictNum -> (# fromInteger $dictNum 3, fromInteger $dictNum 4 #)
-
-No strictness anymore! The bottom line here is that, for inferred types, we
-care about the strictness of the type after the =>. For checked types
-(AbsBindsSig), we care about the overall strictness.
-
-This matters. If we don't separate out the AbsBindsSig case, then GHC runs into
-a problem when compiling
-
-  undefined :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
-
-Looking only after the =>, we cannot tell if this is strict or not. (GHC panics
-if you try.) Looking at the whole type, on the other hand, tells you that this
-is a lifted function type, with no trouble at all.
+Here the binding for 'fm' is illegal.  So generally we check the abe_mono types.
 
+BUT we have a special case when abs_sig is true;
+  see HsBinds Note [The abs_sig field of AbsBinds]
 -}
 
 ----------------- Bindings --------------------------
@@ -846,27 +833,32 @@ is a lifted function type, with no trouble at all.
 -- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
 -- information, see Note [Strict binds check] is DsBinds.
 isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds
-isUnliftedHsBind (AbsBindsSig { abs_sig_export = id })
-  = isUnliftedType (idType id)
 isUnliftedHsBind bind
+  | AbsBinds { abs_exports = exports, abs_sig = has_sig } <- bind
+  = if has_sig
+    then any (is_unlifted_id . abe_poly) exports
+    else any (is_unlifted_id . abe_mono) exports
+    -- If has_sig is True we wil never generate a binding for abe_mono,
+    -- so we don't need to worry about it being unlifted. The abe_poly
+    -- binding might not be: e.g. forall a. Num a => (# a, a #)
+
+  | otherwise
   = any is_unlifted_id (collectHsBindBinders bind)
   where
-    is_unlifted_id id
-      = case tcSplitSigmaTy (idType id) of
-          (_, _, tau) -> isUnliftedType tau
-          -- For the is_unlifted check, we need to look inside polymorphism
-          -- and overloading.  E.g.  x = (# 1, True #)
-          -- would get type forall a. Num a => (# a, Bool #)
-          -- and we want to reject that.  See Trac #9140
-
--- | Is a binding a strict variable bind (e.g. @!x = ...@)?
-isBangedBind :: HsBind GhcTc -> Bool
-isBangedBind b | isBangedPatBind b = True
-isBangedBind (FunBind {fun_matches = matches})
+    is_unlifted_id id = isUnliftedType (idType id)
+
+-- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
+isBangedHsBind :: HsBind GhcTc -> Bool
+isBangedHsBind (AbsBinds { abs_binds = binds })
+  = anyBag (isBangedHsBind . unLoc) binds
+isBangedHsBind (FunBind {fun_matches = matches})
   | [L _ match] <- unLoc $ mg_alts matches
   , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
   = True
-isBangedBind _ = False
+isBangedHsBind (PatBind {pat_lhs = pat})
+  = isBangedLPat pat
+isBangedHsBind _
+  = False
 
 collectLocalBinders :: HsLocalBindsLR idL idR -> [IdP idL]
 collectLocalBinders (HsValBinds binds) = collectHsIdBinders binds
@@ -909,7 +901,6 @@ collect_bind _ (AbsBinds { abs_exports = dbinds }) acc = map abe_poly dbinds ++
         -- I don't think we want the binders from the abe_binds
         -- The only time we collect binders from a typechecked
         -- binding (hence see AbsBinds) is in zonking in TcHsSyn
-collect_bind _ (AbsBindsSig { abs_sig_export = poly }) acc = poly : acc
 collect_bind omitPatSyn (PatSynBind (PSB { psb_id = L _ ps })) acc
   | omitPatSyn                  = acc
   | otherwise                   = ps : acc
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index 76b7793859..a5b724994c 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE CPP #-}
 
 module BuildTyCl (
-        buildDataCon, mkDataConUnivTyVarBinders,
+        buildDataCon,
         buildPatSyn,
         TcMethInfo, buildClass,
         mkNewTyConRhs, mkDataTyConRhs,
@@ -119,7 +119,6 @@ buildDataCon :: FamInstEnvs
 --   a) makes the worker Id
 --   b) makes the wrapper Id if necessary, including
 --      allocating its unique (hence monadic)
---   c) Sorts out the TyVarBinders. See mkDataConUnivTyBinders
 buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs field_lbls
              univ_tvs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
   = do  { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
@@ -165,69 +164,6 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
                       tyCoVarsOfType pred `intersectVarSet` arg_tyvars
 
 
-mkDataConUnivTyVarBinders :: [TyConBinder]   -- From the TyCon
-                          -> [TyVarBinder]   -- For the DataCon
--- See Note [Building the TyBinders for a DataCon]
-mkDataConUnivTyVarBinders tc_bndrs
- = map mk_binder tc_bndrs
- where
-   mk_binder (TvBndr tv tc_vis) = mkTyVarBinder vis tv
-      where
-        vis = case tc_vis of
-                AnonTCB           -> Specified
-                NamedTCB Required -> Specified
-                NamedTCB vis      -> vis
-
-{- Note [Building the TyBinders for a DataCon]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A DataCon needs to keep track of the visibility of its universals and
-existentials, so that visible type application can work properly. This
-is done by storing the universal and existential TyVarBinders.
-See Note [TyVarBinders in DataCons] in DataCon.
-
-During construction of a DataCon, we often start from the TyBinders of
-the parent TyCon.  For example
-   data Maybe a = Nothing | Just a
-The DataCons start from the TyBinders of the parent TyCon.
-
-But the ultimate TyBinders for the DataCon are *different* than those
-of the DataCon. Here is an example:
-
-  data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> *
-
-The TyCon has
-
-  tyConTyVars    = [ k:*,                              a:k->*,      b:k]
-  tyConTyBinders = [ Named (TvBndr (k :: *) Inferred), Anon (k->*), Anon k ]
-
-The TyBinders for App line up with App's kind, given above.
-
-But the DataCon MkApp has the type
-  MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b
-
-That is, its TyBinders should be
-
-  dataConUnivTyVarBinders = [ TvBndr (k:*)    Inferred
-                            , TvBndr (a:k->*) Specified
-                            , TvBndr (b:k)    Specified ]
-
-So we want to take the TyCon's TyBinders and the TyCon's TyVars and
-merge them, pulling
-  - variable names from the TyVars
-  - visibilities from the TyBinders
-  - but changing Anon/Required to Specified
-
-The last part about Required->Specified comes from this:
-  data T k (a:k) b = MkT (a b)
-Here k is Required in T's kind, but we don't have Required binders in
-the TyBinders for a term (see Note [No Required TyBinder in terms]
-in TyCoRep), so we change it to Specified when making MkT's TyBinders
-
-This merging operation is done by mkDataConUnivTyBinders. In contrast,
-the TyBinders passed to mkDataCon are the final TyBinders stored in the
-DataCon (mkDataCon does no further work).
--}
-
 ------------------------------------------------------
 buildPatSyn :: Name -> Bool
             -> (Id,Bool) -> Maybe (Id, Bool)
@@ -310,7 +246,7 @@ buildClass tycon_name binders roles fds Nothing
     do  { traceIf (text "buildClass")
 
         ; tc_rep_name  <- newTyConRepName tycon_name
-        ; let univ_bndrs = mkDataConUnivTyVarBinders binders
+        ; let univ_bndrs = tyConTyVarBinders binders
               univ_tvs   = binderVars univ_bndrs
               tycon = mkClassTyCon tycon_name binders roles
                                    AbstractTyCon rec_clas tc_rep_name
@@ -359,7 +295,7 @@ buildClass tycon_name binders roles fds
               op_names   = [op | (op,_,_) <- sig_stuff]
               arg_tys    = sc_theta ++ op_tys
               rec_tycon  = classTyCon rec_clas
-              univ_bndrs = mkDataConUnivTyVarBinders binders
+              univ_bndrs = tyConTyVarBinders binders
               univ_tvs   = binderVars univ_bndrs
 
         ; rep_nm   <- newTyConRepName datacon_name
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 60206ea076..3360d742ef 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1424,6 +1424,7 @@ freeNamesIfCoercion (IfaceAppCo c1 c2)
   = freeNamesIfCoercion c1 &&& freeNamesIfCoercion c2
 freeNamesIfCoercion (IfaceForAllCo _ kind_co co)
   = freeNamesIfCoercion kind_co &&& freeNamesIfCoercion co
+freeNamesIfCoercion (IfaceFreeCoVar _) = emptyNameSet
 freeNamesIfCoercion (IfaceCoVarCo _)
   = emptyNameSet
 freeNamesIfCoercion (IfaceAxiomInstCo ax _ cos)
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 39e30283db..b1ad780782 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -109,7 +109,7 @@ data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
 type IfaceKind     = IfaceType
 
 data IfaceType     -- A kind of universal type, used for types and kinds
-  = IfaceFreeTyVar TyVar                 -- See Note [Free tyvars in IfaceType]
+  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]
   | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
   | IfaceLitTy     IfaceTyLit
   | IfaceAppTy     IfaceType IfaceType
@@ -204,6 +204,7 @@ Note that:
   to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
   and then pretty-print" pipeline.
 
+We do the same for covars, naturally.
 
 Note [Equality predicates in IfaceType]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -242,6 +243,7 @@ data IfaceCoercion
   | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
   | IfaceAppCo        IfaceCoercion IfaceCoercion
   | IfaceForAllCo     IfaceTvBndr IfaceCoercion IfaceCoercion
+  | IfaceFreeCoVar    CoVar       -- See Note [Free tyvars in IfaceType]
   | IfaceCoVarCo      IfLclName
   | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
   | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
@@ -395,6 +397,7 @@ substIfaceType env ty
     go_co (IfaceTyConAppCo r tc cos) = IfaceTyConAppCo r tc (go_cos cos)
     go_co (IfaceAppCo c1 c2)         = IfaceAppCo (go_co c1) (go_co c2)
     go_co (IfaceForAllCo {})         = pprPanic "substIfaceCoercion" (ppr ty)
+    go_co (IfaceFreeCoVar cv)        = IfaceFreeCoVar cv
     go_co (IfaceCoVarCo cv)          = IfaceCoVarCo cv
     go_co (IfaceAxiomInstCo a i cos) = IfaceAxiomInstCo a i (go_cos cos)
     go_co (IfaceUnivCo prov r t1 t2) = IfaceUnivCo (go_prov prov) r (go t1) (go t2)
@@ -1039,6 +1042,8 @@ ppr_co ctxt_prec co@(IfaceForAllCo {})
       = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
     split_co co' = ([], co')
 
+-- Why these two? See Note [TcTyVars in IfaceType]
+ppr_co _         (IfaceFreeCoVar covar)     = ppr covar
 ppr_co _         (IfaceCoVarCo covar)       = ppr covar
 
 ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
@@ -1065,7 +1070,8 @@ ppr_co ctxt_prec (IfaceAxiomInstCo n i cos)
 ppr_co ctxt_prec (IfaceSymCo co)
   = ppr_special_co ctxt_prec (text "Sym") [co]
 ppr_co ctxt_prec (IfaceTransCo co1 co2)
-  = ppr_special_co ctxt_prec  (text "Trans") [co1,co2]
+  = maybeParen ctxt_prec TyOpPrec $
+    ppr_co TyOpPrec co1 <+> semi <+> ppr_co TyOpPrec co2
 ppr_co ctxt_prec (IfaceNthCo d co)
   = ppr_special_co ctxt_prec (text "Nth:" <> int d) [co]
 ppr_co ctxt_prec (IfaceLRCo lr co)
@@ -1321,6 +1327,8 @@ instance Binary IfaceCoercion where
           put_ bh a
           put_ bh b
           put_ bh c
+  put_ _ (IfaceFreeCoVar cv)
+       = pprPanic "Can't serialise IfaceFreeCoVar" (ppr cv)
   put_ bh (IfaceCoVarCo a) = do
           putByte bh 6
           put_ bh a
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 1477f462fc..9e0616518f 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -893,7 +893,7 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
                                 ; mkNewTyConRhs tycon_name tycon data_con }
   where
     univ_tv_bndrs :: [TyVarBinder]
-    univ_tv_bndrs = mkDataConUnivTyVarBinders tc_tybinders
+    univ_tv_bndrs = tyConTyVarBinders tc_tybinders
 
     tc_con_decl (IfCon { ifConInfix = is_infix,
                          ifConExTvs = ex_bndrs,
@@ -915,7 +915,14 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
         ; ~(eq_spec, theta, arg_tys, stricts) <- forkM (mk_doc dc_name) $
              do { eq_spec <- tcIfaceEqSpec spec
                 ; theta   <- tcIfaceCtxt ctxt
-                ; arg_tys <- mapM tcIfaceType args
+                -- This fixes #13710.  The enclosing lazy thunk gets
+                -- forced when typechecking record wildcard pattern
+                -- matching (it's not completely clear why this
+                -- tuple is needed), which causes trouble if one of
+                -- the argument types was recursively defined.
+                -- See also Note [Tying the knot]
+                ; arg_tys <- forkM (mk_doc dc_name <+> text "arg_tys")
+                           $ mapM tcIfaceType args
                 ; stricts <- mapM tc_strict if_stricts
                         -- The IfBang field can mention
                         -- the type itself; hence inside forkM
@@ -1321,6 +1328,7 @@ tcIfaceCo = go
     go (IfaceForAllCo tv k c)  = do { k' <- go k
                                       ; bindIfaceTyVar tv $ \ tv' ->
                                         ForAllCo tv' k' <$> go c }
+    go (IfaceFreeCoVar c)        = pprPanic "tcIfaceCo:IfaceFreeCoVar" (ppr c)
     go (IfaceCoVarCo n)          = CoVarCo <$> go_var n
     go (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n <*> pure i <*> mapM go cs
     go (IfaceUnivCo p r t1 t2)   = UnivCo <$> tcIfaceUnivCoProv p <*> pure r
diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs
index 6f2acba21d..f5cbe9e5c7 100644
--- a/compiler/iface/ToIface.hs
+++ b/compiler/iface/ToIface.hs
@@ -22,7 +22,7 @@ module ToIface
     , tidyToIfaceContext
     , tidyToIfaceTcArgs
       -- * Coercions
-    , toIfaceCoercion
+    , toIfaceCoercion, toIfaceCoercionX
       -- * Pattern synonyms
     , patSynToIfaceDecl
       -- * Expressions
@@ -216,8 +216,11 @@ toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
 toIfaceCoercionX fr co
   = go co
   where
-    go (Refl r ty)          = IfaceReflCo r (toIfaceType ty)
-    go (CoVarCo cv)         = IfaceCoVarCo  (toIfaceCoVar cv)
+    go (Refl r ty)          = IfaceReflCo r (toIfaceTypeX fr ty)
+    go (CoVarCo cv)
+      -- See [TcTyVars in IfaceType] in IfaceType
+      | cv `elemVarSet` fr  = IfaceFreeCoVar cv
+      | otherwise           = IfaceCoVarCo  (toIfaceCoVar cv)
     go (AppCo co1 co2)      = IfaceAppCo  (go co1) (go co2)
     go (SymCo co)           = IfaceSymCo (go co)
     go (TransCo co1 co2)    = IfaceTransCo (go co1) (go co2)
@@ -236,8 +239,7 @@ toIfaceCoercionX fr co
       | tc `hasKey` funTyConKey
       , [_,_,_,_] <- cos         = pprPanic "toIfaceCoercion" (ppr co)
       | otherwise                = IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)
-    go (FunCo r co1 co2)   = IfaceFunCo r (toIfaceCoercion co1)
-                                          (toIfaceCoercion co2)
+    go (FunCo r co1 co2)   = IfaceFunCo r (go co1) (go co2)
 
     go (ForAllCo tv k co) = IfaceForAllCo (toIfaceTvBndr tv)
                                           (toIfaceCoercionX fr' k)
diff --git a/compiler/iface/ToIface.hs-boot b/compiler/iface/ToIface.hs-boot
index e2431b82dc..cdb472692e 100644
--- a/compiler/iface/ToIface.hs-boot
+++ b/compiler/iface/ToIface.hs-boot
@@ -13,4 +13,4 @@ toIfaceTyLit :: TyLit -> IfaceTyLit
 toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
-toIfaceCoercion :: Coercion -> IfaceCoercion
+toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs
index 8f38c799c7..7dd3c4807b 100644
--- a/compiler/llvmGen/Llvm/AbsSyn.hs
+++ b/compiler/llvmGen/Llvm/AbsSyn.hs
@@ -323,8 +323,8 @@ data LlvmExpression
     basic block in a new variable of type tp.
       * tp:         type of the merged variable, must match the types of the
                     predecessor variables.
-      * precessors: A list of variables and the basic block that they originate
-                    from.
+      * predecessors: A list of variables and the basic block that they originate
+                      from.
   -}
   | Phi LlvmType [(LlvmVar,LlvmVar)]
 
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 293999bd1e..f2eeffe114 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -238,7 +238,7 @@ ppLlvmExpression expr
         Malloc     tp amount        -> ppMalloc tp amount
         AtomicRMW  aop tgt src ordering -> ppAtomicRMW aop tgt src ordering
         CmpXChg    addr old new s_ord f_ord -> ppCmpXChg addr old new s_ord f_ord
-        Phi        tp precessors    -> ppPhi tp precessors
+        Phi        tp predecessors  -> ppPhi tp predecessors
         Asm        asm c ty v se sk -> ppAsm asm c ty v se sk
         MExpr      meta expr        -> ppMetaExpr meta expr
 
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index f6ff838d14..f09237c6d9 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -36,10 +36,8 @@ import Util
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Writer
 
-#if __GLASGOW_HASKELL__ > 710
 import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
-#endif
 import Data.List ( nub )
 import Data.Maybe ( catMaybes )
 
@@ -1863,11 +1861,9 @@ getTBAARegMeta = getTBAAMeta . getTBAA
 -- | A more convenient way of accumulating LLVM statements and declarations.
 data LlvmAccum = LlvmAccum LlvmStatements [LlvmCmmDecl]
 
-#if __GLASGOW_HASKELL__ > 710
 instance Semigroup LlvmAccum where
   LlvmAccum stmtsA declsA <> LlvmAccum stmtsB declsB =
         LlvmAccum (stmtsA Semigroup.<> stmtsB) (declsA Semigroup.<> declsB)
-#endif
 
 instance Monoid LlvmAccum where
     mempty = LlvmAccum nilOL []
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 3fc35e5992..7f70377c25 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -1932,6 +1932,7 @@ linkBinary' staticLink dflags o_files dep_packages = do
                       ++ [ SysTools.Option "-o"
                          , SysTools.FileOption "" output_fn
                          ]
+                      ++ libmLinkOpts
                       ++ map SysTools.Option (
                          []
 
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index cc9bbb8684..e57ea02834 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1319,7 +1319,9 @@ data DynLibLoader
   | SystemDependent
   deriving Eq
 
-data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
+data RtsOptsEnabled
+  = RtsOptsNone | RtsOptsIgnore | RtsOptsIgnoreAll | RtsOptsSafeOnly
+  | RtsOptsAll
   deriving (Show)
 
 shouldUseColor :: DynFlags -> Bool
@@ -2835,6 +2837,10 @@ dynamic_flags_deps = [
         (NoArg (setRtsOptsEnabled RtsOptsSafeOnly))
   , make_ord_flag defGhcFlag "rtsopts=none"
         (NoArg (setRtsOptsEnabled RtsOptsNone))
+  , make_ord_flag defGhcFlag "rtsopts=ignore"
+        (NoArg (setRtsOptsEnabled RtsOptsIgnore))
+  , make_ord_flag defGhcFlag "rtsopts=ignoreAll"
+        (NoArg (setRtsOptsEnabled RtsOptsIgnoreAll))
   , make_ord_flag defGhcFlag "no-rtsopts"
         (NoArg (setRtsOptsEnabled RtsOptsNone))
   , make_ord_flag defGhcFlag "no-rtsopts-suggestions"
diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs
index cb0121950f..e45ef6dde3 100644
--- a/compiler/main/InteractiveEvalTypes.hs
+++ b/compiler/main/InteractiveEvalTypes.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 -- -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow, 2005-2007
@@ -25,11 +23,7 @@ import SrcLoc
 import Exception
 
 import Data.Word
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
-#else
-import GHC.Stack as GHC.Stack.CCS
-#endif
 
 data ExecOptions
  = ExecOptions
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 2c5833fae4..50b9967e01 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -88,12 +88,9 @@ import Data.Char ( toUpper )
 import Data.List as List
 import Data.Map (Map)
 import Data.Set (Set)
-import Data.Maybe (mapMaybe)
 import Data.Monoid (First(..))
-#if __GLASGOW_HASKELL__ > 710
 import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
-#endif
 import qualified Data.Map as Map
 import qualified Data.Map.Strict as MapStrict
 import qualified Data.Set as Set
@@ -207,7 +204,6 @@ fromReexportedModules False pkg = ModOrigin Nothing [] [pkg] False
 fromFlag :: ModuleOrigin
 fromFlag = ModOrigin Nothing [] [] True
 
-#if __GLASGOW_HASKELL__ > 710
 instance Semigroup ModuleOrigin where
     ModOrigin e res rhs f <> ModOrigin e' res' rhs' f' =
         ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f')
@@ -217,7 +213,6 @@ instance Semigroup ModuleOrigin where
             g Nothing x = x
             g x Nothing = x
     _x <> _y = panic "ModOrigin: hidden module redefined"
-#endif
 
 instance Monoid ModuleOrigin where
     mempty = ModOrigin Nothing [] [] False
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 3d16124d72..c73e47c16a 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -39,6 +39,9 @@ module SysTools (
 
         Option(..),
 
+        -- platform-specifics
+        libmLinkOpts,
+
         -- frameworks
         getPkgFrameworkOpts,
         getFrameworkOpts
@@ -1537,6 +1540,7 @@ linkDynLib dflags0 o_files dep_packages
 
             runLink dflags (
                     map Option verbFlags
+                 ++ libmLinkOpts
                  ++ [ Option "-o"
                     , FileOption "" output_fn
                     ]
@@ -1556,6 +1560,16 @@ linkDynLib dflags0 o_files dep_packages
                  ++ map Option pkg_link_opts
               )
 
+-- | Some platforms require that we explicitly link against @libm@ if any
+-- math-y things are used (which we assume to include all programs). See #14022.
+libmLinkOpts :: [Option]
+libmLinkOpts =
+#if defined(HAVE_LIBM)
+  [Option "-lm"]
+#else
+  []
+#endif
+
 getPkgFrameworkOpts :: DynFlags -> Platform -> [InstalledUnitId] -> IO [String]
 getPkgFrameworkOpts dflags platform dep_packages
   | platformUsesFrameworks platform = do
diff --git a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
index 7e8047f29f..832df2334e 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Coalesce.hs
@@ -62,7 +62,7 @@ sinkReg fm r
 
 -- | Slurp out mov instructions that only serve to join live ranges.
 --
---   During a mov, if the source reg dies and the destiation reg is
+--   During a mov, if the source reg dies and the destination reg is
 --   born then we can rename the two regs to the same thing and
 --   eliminate the move.
 slurpJoinMovs
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 0014ab6fed..b86b143f59 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -34,7 +34,7 @@ import qualified Data.IntSet    as IntSet
 --   TODO: See if we can split some of the live ranges instead of just globally
 --         spilling the virtual reg. This might make the spill cleaner's job easier.
 --
---   TODO: On CISCy x86 and x86_64 we don't nessesarally have to add a mov instruction
+--   TODO: On CISCy x86 and x86_64 we don't necessarily have to add a mov instruction
 --         when making spills. If an instr is using a spilled virtual we may be able to
 --         address the spill slot directly.
 --
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index 341fa43dbc..bd4774ae2c 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -2,9 +2,7 @@
 
 -- The default iteration limit is a bit too low for the definitions
 -- in this module.
-#if __GLASGOW_HASKELL__ >= 800
 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}
-#endif
 
 -----------------------------------------------------------------------------
 --
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 936948b40f..c5332fbe2f 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -77,9 +77,7 @@ module Lexer (
 
 -- base
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import Control.Monad.Fail
-#endif
 import Data.Bits
 import Data.Char
 import Data.List
@@ -1894,10 +1892,8 @@ instance Monad P where
   (>>=) = thenP
   fail = failP
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail P where
   fail = failP
-#endif
 
 returnP :: a -> P a
 returnP a = a `seq` (P $ \s -> POk s a)
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 8f352ee971..b2a1b41a4c 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -425,8 +425,8 @@ getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1),
 getMonoBind bind binds = (bind, binds)
 
 has_args :: [LMatch GhcPs (LHsExpr GhcPs)] -> Bool
-has_args []                           = panic "RdrHsSyn:has_args"
-has_args ((L _ (Match _ args _ _)) : _) = not (null args)
+has_args []                                    = panic "RdrHsSyn:has_args"
+has_args ((L _ (Match { m_pats = args })) : _) = not (null args)
         -- Don't group together FunBinds if they have
         -- no arguments.  This is necessary now that variable bindings
         -- with no arguments are now treated as FunBinds rather
@@ -514,10 +514,16 @@ mkPatSynMatchGroup (L loc patsyn_name) (L _ decls) =
         do { unless (name == patsyn_name) $
                wrongNameBindingErr loc decl
            ; match <- case details of
-               PrefixCon pats ->
-                        return $ Match (FunRhs ln Prefix NoSrcStrict) pats Nothing rhs
-               InfixCon pat1 pat2 ->
-                       return $ Match (FunRhs ln Infix NoSrcStrict) [pat1, pat2] Nothing rhs
+               PrefixCon pats -> return $ Match { m_ctxt = ctxt, m_pats = pats
+                                                , m_type = Nothing, m_grhss = rhs }
+                   where
+                     ctxt = FunRhs { mc_fun = ln, mc_fixity = Prefix, mc_strictness = NoSrcStrict }
+
+               InfixCon p1 p2 -> return $ Match { m_ctxt = ctxt, m_pats = [p1, p2]
+                                                , m_type = Nothing, m_grhss = rhs }
+                   where
+                     ctxt = FunRhs { mc_fun = ln, mc_fixity = Infix, mc_strictness = NoSrcStrict }
+
                RecCon{} -> recordPatSynErr loc pat
            ; return $ L loc match }
     fromDecl (L loc decl) = extraDeclErr loc decl
@@ -960,7 +966,9 @@ checkFunBind msg strictness ann lhs_loc fun is_infix pats opt_sig (L rhs_span gr
         -- Add back the annotations stripped from any HsPar values in the lhs
         -- mapM_ (\a -> a match_span) ann
         return (ann, makeFunBind fun
-                  [L match_span (Match { m_ctxt = FunRhs fun is_infix strictness
+                  [L match_span (Match { m_ctxt = FunRhs { mc_fun    = fun
+                                                         , mc_fixity = is_infix
+                                                         , mc_strictness = strictness }
                                        , m_pats = ps
                                        , m_type = opt_sig
                                        , m_grhss = grhss })])
@@ -1075,7 +1083,7 @@ isFunLhs e = go e [] []
    go (L l (HsPar e))   es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
 
         -- Things of the form `!x` are also FunBinds
-        -- See Note [Varieties of binding pattern matches]
+        -- See Note [FunBind vs PatBind]
    go (L _ (SectionR (L _ (HsVar (L _ bang))) (L l (HsVar (L _ var))))) [] ann
         | bang == bang_RDR
         , not (isRdrDataCon var)     = return (Just (L l var, Prefix, [], ann))
@@ -1239,9 +1247,9 @@ checkCmdMatchGroup :: MatchGroup GhcPs (LHsExpr GhcPs)
 checkCmdMatchGroup mg@(MG { mg_alts = L l ms }) = do
     ms' <- mapM (locMap $ const convert) ms
     return $ mg { mg_alts = L l ms' }
-    where convert (Match mf pat mty grhss) = do
+    where convert match@(Match { m_grhss = grhss }) = do
             grhss' <- checkCmdGRHSs grhss
-            return $ Match mf pat mty grhss'
+            return $ match { m_grhss = grhss'}
 
 checkCmdGRHSs :: GRHSs GhcPs (LHsExpr GhcPs) -> P (GRHSs GhcPs (LHsCmd GhcPs))
 checkCmdGRHSs (GRHSs grhss binds) = do
diff --git a/compiler/prelude/KnownUniques.hs b/compiler/prelude/KnownUniques.hs
index 8f1b0b6347..60fa0e2435 100644
--- a/compiler/prelude/KnownUniques.hs
+++ b/compiler/prelude/KnownUniques.hs
@@ -79,7 +79,8 @@ knownUniqueName u =
 
 mkSumTyConUnique :: Arity -> Unique
 mkSumTyConUnique arity =
-    ASSERT(arity < 0xff)
+    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
+                         -- alternative
     mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
 
 mkSumDataConUnique :: ConTagZ -> Arity -> Unique
@@ -98,16 +99,18 @@ getUnboxedSumName n
       _   -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
   | tag == 0x0
   = dataConName $ sumDataCon (alt + 1) arity
+  | tag == 0x1
+  = getName $ dataConWrapId $ sumDataCon (alt + 1) arity
   | tag == 0x2
   = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
   | otherwise
   = pprPanic "getUnboxedSumName" (ppr n)
   where
     arity = n `shiftR` 8
-    alt = (n .&. 0xff) `shiftR` 2
+    alt = (n .&. 0xfc) `shiftR` 2
     tag = 0x3 .&. n
     getRep tycon =
-        fromMaybe (pprPanic "getUnboxedSumName" (ppr tycon))
+        fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))
         $ tyConRepName_maybe tycon
 
 -- Note [Uniques for tuple type and data constructors]
diff --git a/compiler/prelude/PrelRules.hs b/compiler/prelude/PrelRules.hs
index 1ef0565ff3..2dbc5e888d 100644
--- a/compiler/prelude/PrelRules.hs
+++ b/compiler/prelude/PrelRules.hs
@@ -1517,7 +1517,7 @@ into
      0# -> e1
      1# -> e1
 
-This rule elimiantes a lot of boilerplate. For
+This rule eliminates a lot of boilerplate. For
   if (x>y) then e1 else e2
 we generate
   case tagToEnum (x ># y) of
diff --git a/compiler/prelude/THNames.hs b/compiler/prelude/THNames.hs
index 85362434cc..4128ab375e 100644
--- a/compiler/prelude/THNames.hs
+++ b/compiler/prelude/THNames.hs
@@ -95,7 +95,7 @@ templateHaskellNames = [
     -- Type
     forallTName, varTName, conTName, appTName, equalityTName,
     tupleTName, unboxedTupleTName, unboxedSumTName,
-    arrowTName, listTName, sigTName, sigTDataConName, litTName,
+    arrowTName, listTName, sigTName, litTName,
     promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
     wildCardTName,
     -- TyLit
@@ -152,10 +152,10 @@ templateHaskellNames = [
     clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
     stmtQTyConName, decQTyConName, conQTyConName, bangTypeQTyConName,
     varBangTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
-    typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
+    typeTyConName, tyVarBndrQTyConName, matchTyConName, clauseTyConName,
     patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
     predQTyConName, decsQTyConName, ruleBndrQTyConName, tySynEqnQTyConName,
-    roleTyConName, tExpTyConName, injAnnTyConName, kindTyConName,
+    roleTyConName, tExpTyConName, injAnnTyConName, kindQTyConName,
     overlapTyConName, derivClauseQTyConName, derivStrategyTyConName,
 
     -- Quasiquoting
@@ -163,7 +163,7 @@ templateHaskellNames = [
 
 thSyn, thLib, qqLib :: Module
 thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
-thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
+thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib.Internal")
 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
 
 mkTHModule :: FastString -> Module
@@ -184,9 +184,9 @@ liftClassName = thCls (fsLit "Lift") liftClassKey
 
 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
     fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
-    tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
-    predTyConName, tExpTyConName, injAnnTyConName, kindTyConName,
-    overlapTyConName, derivStrategyTyConName :: Name
+    matchTyConName, clauseTyConName, funDepTyConName, predTyConName,
+    tExpTyConName, injAnnTyConName, overlapTyConName,
+    derivStrategyTyConName :: Name
 qTyConName             = thTc (fsLit "Q")              qTyConKey
 nameTyConName          = thTc (fsLit "Name")           nameTyConKey
 fieldExpTyConName      = thTc (fsLit "FieldExp")       fieldExpTyConKey
@@ -195,14 +195,12 @@ fieldPatTyConName      = thTc (fsLit "FieldPat")       fieldPatTyConKey
 expTyConName           = thTc (fsLit "Exp")            expTyConKey
 decTyConName           = thTc (fsLit "Dec")            decTyConKey
 typeTyConName          = thTc (fsLit "Type")           typeTyConKey
-tyVarBndrTyConName     = thTc (fsLit "TyVarBndr")      tyVarBndrTyConKey
 matchTyConName         = thTc (fsLit "Match")          matchTyConKey
 clauseTyConName        = thTc (fsLit "Clause")         clauseTyConKey
 funDepTyConName        = thTc (fsLit "FunDep")         funDepTyConKey
 predTyConName          = thTc (fsLit "Pred")           predTyConKey
 tExpTyConName          = thTc (fsLit "TExp")           tExpTyConKey
 injAnnTyConName        = thTc (fsLit "InjectivityAnn") injAnnTyConKey
-kindTyConName          = thTc (fsLit "Kind")           kindTyConKey
 overlapTyConName       = thTc (fsLit "Overlap")        overlapTyConKey
 derivStrategyTyConName = thTc (fsLit "DerivStrategy")  derivStrategyTyConKey
 
@@ -347,38 +345,36 @@ funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
     openTypeFamilyDName, closedTypeFamilyDName, infixLDName, infixRDName,
     infixNDName, roleAnnotDName, patSynDName, patSynSigDName,
     pragCompleteDName :: Name
-funDName             = libFun (fsLit "funD")              funDIdKey
-valDName             = libFun (fsLit "valD")              valDIdKey
-dataDName            = libFun (fsLit "dataD")             dataDIdKey
-newtypeDName         = libFun (fsLit "newtypeD")          newtypeDIdKey
-tySynDName           = libFun (fsLit "tySynD")            tySynDIdKey
-classDName           = libFun (fsLit "classD")            classDIdKey
-instanceWithOverlapDName
-  = libFun (fsLit "instanceWithOverlapD")              instanceWithOverlapDIdKey
-standaloneDerivWithStrategyDName = libFun
-        (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey
-sigDName             = libFun (fsLit "sigD")              sigDIdKey
-defaultSigDName      = libFun (fsLit "defaultSigD")       defaultSigDIdKey
-forImpDName          = libFun (fsLit "forImpD")           forImpDIdKey
-pragInlDName         = libFun (fsLit "pragInlD")          pragInlDIdKey
-pragSpecDName        = libFun (fsLit "pragSpecD")         pragSpecDIdKey
-pragSpecInlDName     = libFun (fsLit "pragSpecInlD")      pragSpecInlDIdKey
-pragSpecInstDName    = libFun (fsLit "pragSpecInstD")     pragSpecInstDIdKey
-pragRuleDName        = libFun (fsLit "pragRuleD")         pragRuleDIdKey
-pragCompleteDName    = libFun (fsLit "pragCompleteD")     pragCompleteDIdKey
-pragAnnDName         = libFun (fsLit "pragAnnD")          pragAnnDIdKey
-dataInstDName        = libFun (fsLit "dataInstD")         dataInstDIdKey
-newtypeInstDName     = libFun (fsLit "newtypeInstD")      newtypeInstDIdKey
-tySynInstDName       = libFun (fsLit "tySynInstD")        tySynInstDIdKey
-openTypeFamilyDName  = libFun (fsLit "openTypeFamilyD")   openTypeFamilyDIdKey
-closedTypeFamilyDName= libFun (fsLit "closedTypeFamilyD") closedTypeFamilyDIdKey
-dataFamilyDName      = libFun (fsLit "dataFamilyD")       dataFamilyDIdKey
-infixLDName          = libFun (fsLit "infixLD")           infixLDIdKey
-infixRDName          = libFun (fsLit "infixRD")           infixRDIdKey
-infixNDName          = libFun (fsLit "infixND")           infixNDIdKey
-roleAnnotDName       = libFun (fsLit "roleAnnotD")        roleAnnotDIdKey
-patSynDName          = libFun (fsLit "patSynD")           patSynDIdKey
-patSynSigDName       = libFun (fsLit "patSynSigD")        patSynSigDIdKey
+funDName                         = libFun (fsLit "funD")                         funDIdKey
+valDName                         = libFun (fsLit "valD")                         valDIdKey
+dataDName                        = libFun (fsLit "dataD")                        dataDIdKey
+newtypeDName                     = libFun (fsLit "newtypeD")                     newtypeDIdKey
+tySynDName                       = libFun (fsLit "tySynD")                       tySynDIdKey
+classDName                       = libFun (fsLit "classD")                       classDIdKey
+instanceWithOverlapDName         = libFun (fsLit "instanceWithOverlapD")         instanceWithOverlapDIdKey
+standaloneDerivWithStrategyDName = libFun (fsLit "standaloneDerivWithStrategyD") standaloneDerivWithStrategyDIdKey
+sigDName                         = libFun (fsLit "sigD")                         sigDIdKey
+defaultSigDName                  = libFun (fsLit "defaultSigD")                  defaultSigDIdKey
+forImpDName                      = libFun (fsLit "forImpD")                      forImpDIdKey
+pragInlDName                     = libFun (fsLit "pragInlD")                     pragInlDIdKey
+pragSpecDName                    = libFun (fsLit "pragSpecD")                    pragSpecDIdKey
+pragSpecInlDName                 = libFun (fsLit "pragSpecInlD")                 pragSpecInlDIdKey
+pragSpecInstDName                = libFun (fsLit "pragSpecInstD")                pragSpecInstDIdKey
+pragRuleDName                    = libFun (fsLit "pragRuleD")                    pragRuleDIdKey
+pragCompleteDName                = libFun (fsLit "pragCompleteD")                pragCompleteDIdKey
+pragAnnDName                     = libFun (fsLit "pragAnnD")                     pragAnnDIdKey
+dataInstDName                    = libFun (fsLit "dataInstD")                    dataInstDIdKey
+newtypeInstDName                 = libFun (fsLit "newtypeInstD")                 newtypeInstDIdKey
+tySynInstDName                   = libFun (fsLit "tySynInstD")                   tySynInstDIdKey
+openTypeFamilyDName              = libFun (fsLit "openTypeFamilyD")              openTypeFamilyDIdKey
+closedTypeFamilyDName            = libFun (fsLit "closedTypeFamilyD")            closedTypeFamilyDIdKey
+dataFamilyDName                  = libFun (fsLit "dataFamilyD")                  dataFamilyDIdKey
+infixLDName                      = libFun (fsLit "infixLD")                      infixLDIdKey
+infixRDName                      = libFun (fsLit "infixRD")                      infixRDIdKey
+infixNDName                      = libFun (fsLit "infixND")                      infixNDIdKey
+roleAnnotDName                   = libFun (fsLit "roleAnnotD")                   roleAnnotDIdKey
+patSynDName                      = libFun (fsLit "patSynD")                      patSynDIdKey
+patSynSigDName                   = libFun (fsLit "patSynSigD")                   patSynSigDIdKey
 
 -- type Ctxt = ...
 cxtName :: Name
@@ -432,7 +428,7 @@ recordPatSynName = libFun (fsLit "recordPatSyn") recordPatSynIdKey
 -- data Type = ...
 forallTName, varTName, conTName, tupleTName, unboxedTupleTName,
     unboxedSumTName, arrowTName, listTName, appTName, sigTName,
-    sigTDataConName, equalityTName, litTName, promotedTName,
+    equalityTName, litTName, promotedTName,
     promotedTupleTName, promotedNilTName, promotedConsTName,
     wildCardTName :: Name
 forallTName         = libFun (fsLit "forallT")        forallTIdKey
@@ -445,9 +441,6 @@ arrowTName          = libFun (fsLit "arrowT")         arrowTIdKey
 listTName           = libFun (fsLit "listT")          listTIdKey
 appTName            = libFun (fsLit "appT")           appTIdKey
 sigTName            = libFun (fsLit "sigT")           sigTIdKey
--- Yes, we need names for both the monadic sigT as well as the pure SigT. Why?
--- Refer to the documentation for repLKind in DsMeta.
-sigTDataConName     = thCon  (fsLit "SigT")           sigTDataConKey
 equalityTName       = libFun (fsLit "equalityT")      equalityTIdKey
 litTName            = libFun (fsLit "litT")           litTIdKey
 promotedTName       = libFun (fsLit "promotedT")      promotedTIdKey
@@ -463,8 +456,8 @@ strTyLitName = libFun (fsLit "strTyLit") strTyLitIdKey
 
 -- data TyVarBndr = ...
 plainTVName, kindedTVName :: Name
-plainTVName       = libFun (fsLit "plainTV")       plainTVIdKey
-kindedTVName      = libFun (fsLit "kindedTV")      kindedTVIdKey
+plainTVName  = libFun (fsLit "plainTV")  plainTVIdKey
+kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
 
 -- data Role = ...
 nominalRName, representationalRName, phantomRName, inferRName :: Name
@@ -487,9 +480,9 @@ constraintKName = libFun (fsLit "constraintK")  constraintKIdKey
 
 -- data FamilyResultSig = ...
 noSigName, kindSigName, tyVarSigName :: Name
-noSigName       = libFun (fsLit "noSig")        noSigIdKey
-kindSigName     = libFun (fsLit "kindSig")      kindSigIdKey
-tyVarSigName    = libFun (fsLit "tyVarSig")     tyVarSigIdKey
+noSigName    = libFun (fsLit "noSig")    noSigIdKey
+kindSigName  = libFun (fsLit "kindSig")  kindSigIdKey
+tyVarSigName = libFun (fsLit "tyVarSig") tyVarSigIdKey
 
 -- data InjectivityAnn = ...
 injectivityAnnName :: Name
@@ -546,7 +539,7 @@ matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
     varBangTypeQTyConName, typeQTyConName, fieldExpQTyConName,
     patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName,
     ruleBndrQTyConName, tySynEqnQTyConName, roleTyConName,
-    derivClauseQTyConName :: Name
+    derivClauseQTyConName, kindQTyConName, tyVarBndrQTyConName :: Name
 matchQTyConName         = libTc (fsLit "MatchQ")         matchQTyConKey
 clauseQTyConName        = libTc (fsLit "ClauseQ")        clauseQTyConKey
 expQTyConName           = libTc (fsLit "ExpQ")           expQTyConKey
@@ -565,6 +558,8 @@ ruleBndrQTyConName      = libTc (fsLit "RuleBndrQ")      ruleBndrQTyConKey
 tySynEqnQTyConName      = libTc (fsLit "TySynEqnQ")      tySynEqnQTyConKey
 roleTyConName           = libTc (fsLit "Role")           roleTyConKey
 derivClauseQTyConName   = libTc (fsLit "DerivClauseQ")   derivClauseQTyConKey
+kindQTyConName          = libTc (fsLit "KindQ")          kindQTyConKey
+tyVarBndrQTyConName     = libTc (fsLit "TyVarBndrQ")     tyVarBndrQTyConKey
 
 -- quasiquoting
 quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
@@ -630,12 +625,12 @@ liftClassKey = mkPreludeClassUnique 200
 
 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
     decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
-    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
-    decTyConKey, bangTypeQTyConKey, varBangTypeQTyConKey,
+    stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey,
+    tyVarBndrQTyConKey, decTyConKey, bangTypeQTyConKey, varBangTypeQTyConKey,
     fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
     fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
     predQTyConKey, decsQTyConKey, ruleBndrQTyConKey, tySynEqnQTyConKey,
-    roleTyConKey, tExpTyConKey, injAnnTyConKey, kindTyConKey,
+    roleTyConKey, tExpTyConKey, injAnnTyConKey, kindQTyConKey,
     overlapTyConKey, derivClauseQTyConKey, derivStrategyTyConKey :: Unique
 expTyConKey             = mkPreludeTyConUnique 200
 matchTyConKey           = mkPreludeTyConUnique 201
@@ -662,14 +657,14 @@ fieldExpQTyConKey       = mkPreludeTyConUnique 221
 funDepTyConKey          = mkPreludeTyConUnique 222
 predTyConKey            = mkPreludeTyConUnique 223
 predQTyConKey           = mkPreludeTyConUnique 224
-tyVarBndrTyConKey       = mkPreludeTyConUnique 225
+tyVarBndrQTyConKey      = mkPreludeTyConUnique 225
 decsQTyConKey           = mkPreludeTyConUnique 226
 ruleBndrQTyConKey       = mkPreludeTyConUnique 227
 tySynEqnQTyConKey       = mkPreludeTyConUnique 228
 roleTyConKey            = mkPreludeTyConUnique 229
 tExpTyConKey            = mkPreludeTyConUnique 230
 injAnnTyConKey          = mkPreludeTyConUnique 231
-kindTyConKey            = mkPreludeTyConUnique 232
+kindQTyConKey           = mkPreludeTyConUnique 232
 overlapTyConKey         = mkPreludeTyConUnique 233
 derivClauseQTyConKey    = mkPreludeTyConUnique 234
 derivStrategyTyConKey   = mkPreludeTyConUnique 235
@@ -955,7 +950,7 @@ recordPatSynIdKey = mkPreludeMiscIdUnique 372
 -- data Type = ...
 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey,
     unboxedSumTIdKey, arrowTIdKey, listTIdKey, appTIdKey, sigTIdKey,
-    sigTDataConKey, equalityTIdKey, litTIdKey, promotedTIdKey,
+    equalityTIdKey, litTIdKey, promotedTIdKey,
     promotedTupleTIdKey, promotedNilTIdKey, promotedConsTIdKey,
     wildCardTIdKey :: Unique
 forallTIdKey        = mkPreludeMiscIdUnique 381
@@ -968,14 +963,13 @@ arrowTIdKey         = mkPreludeMiscIdUnique 387
 listTIdKey          = mkPreludeMiscIdUnique 388
 appTIdKey           = mkPreludeMiscIdUnique 389
 sigTIdKey           = mkPreludeMiscIdUnique 390
-sigTDataConKey      = mkPreludeMiscIdUnique 391
-equalityTIdKey      = mkPreludeMiscIdUnique 392
-litTIdKey           = mkPreludeMiscIdUnique 393
-promotedTIdKey      = mkPreludeMiscIdUnique 394
-promotedTupleTIdKey = mkPreludeMiscIdUnique 395
-promotedNilTIdKey   = mkPreludeMiscIdUnique 396
-promotedConsTIdKey  = mkPreludeMiscIdUnique 397
-wildCardTIdKey      = mkPreludeMiscIdUnique 398
+equalityTIdKey      = mkPreludeMiscIdUnique 391
+litTIdKey           = mkPreludeMiscIdUnique 392
+promotedTIdKey      = mkPreludeMiscIdUnique 393
+promotedTupleTIdKey = mkPreludeMiscIdUnique 394
+promotedNilTIdKey   = mkPreludeMiscIdUnique 395
+promotedConsTIdKey  = mkPreludeMiscIdUnique 396
+wildCardTIdKey      = mkPreludeMiscIdUnique 397
 
 -- data TyLit = ...
 numTyLitIdKey, strTyLitIdKey :: Unique
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index 28c6629a91..5a8c4aae78 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -162,10 +162,6 @@ import Util
 import BooleanFormula   ( mkAnd )
 
 import qualified Data.ByteString.Char8 as BS
-#if !MIN_VERSION_bytestring(0,10,8)
-import qualified Data.ByteString.Internal as BSI
-import qualified Data.ByteString.Unsafe as BSU
-#endif
 
 alpha_tyvar :: [TyVar]
 alpha_tyvar = [alphaTyVar]
@@ -690,7 +686,7 @@ isBuiltInOcc_maybe occ =
 
       -- boxed tuple data/tycon
       "()"    -> Just $ tup_name Boxed 0
-      _ | Just rest <- "(" `stripPrefix` name
+      _ | Just rest <- "(" `BS.stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , ")" <- rest'
              -> Just $ tup_name Boxed (1+BS.length commas)
@@ -698,21 +694,21 @@ isBuiltInOcc_maybe occ =
       -- unboxed tuple data/tycon
       "(##)"  -> Just $ tup_name Unboxed 0
       "Unit#" -> Just $ tup_name Unboxed 1
-      _ | Just rest <- "(#" `stripPrefix` name
+      _ | Just rest <- "(#" `BS.stripPrefix` name
         , (commas, rest') <- BS.span (==',') rest
         , "#)" <- rest'
              -> Just $ tup_name Unboxed (1+BS.length commas)
 
       -- unboxed sum tycon
-      _ | Just rest <- "(#" `stripPrefix` name
+      _ | Just rest <- "(#" `BS.stripPrefix` name
         , (pipes, rest') <- BS.span (=='|') rest
         , "#)" <- rest'
              -> Just $ tyConName $ sumTyCon (1+BS.length pipes)
 
       -- unboxed sum datacon
-      _ | Just rest <- "(#" `stripPrefix` name
+      _ | Just rest <- "(#" `BS.stripPrefix` name
         , (pipes1, rest') <- BS.span (=='|') rest
-        , Just rest'' <- "_" `stripPrefix` rest'
+        , Just rest'' <- "_" `BS.stripPrefix` rest'
         , (pipes2, rest''') <- BS.span (=='|') rest''
         , "#)" <- rest'''
              -> let arity = BS.length pipes1 + BS.length pipes2 + 1
@@ -720,15 +716,6 @@ isBuiltInOcc_maybe occ =
                 in Just $ dataConName $ sumDataCon alt arity
       _ -> Nothing
   where
-    -- TODO: Drop when bytestring 0.10.8 can be assumed
-#if MIN_VERSION_bytestring(0,10,8)
-    stripPrefix = BS.stripPrefix
-#else
-    stripPrefix bs1@(BSI.PS _ _ l1) bs2
-      | bs1 `BS.isPrefixOf` bs2 = Just (BSU.unsafeDrop l1 bs2)
-      | otherwise = Nothing
-#endif
-
     name = fastStringToByteString $ occNameFS occ
 
     choose_ns :: Name -> Name -> Name
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index 97ae89cb84..8039913110 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -1238,7 +1238,7 @@ primop  ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
 
 primop  ReadByteArrayOp_Int "readIntArray#" GenPrimOp
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
-   {Read intger; offset in words.}
+   {Read integer; offset in words.}
    with has_side_effects = True
         can_fail = True
 
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index cb14ceb840..25613dc018 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -47,7 +47,7 @@ import NameSet
 import RdrName          ( RdrName, rdrNameOcc )
 import SrcLoc
 import ListSetOps       ( findDupsEq )
-import BasicTypes       ( RecFlag(..), LexicalFixity(..) )
+import BasicTypes       ( RecFlag(..) )
 import Digraph          ( SCC(..) )
 import Bag
 import Util
@@ -58,7 +58,9 @@ import Maybes           ( orElse )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
-import Data.List        ( partition, sort )
+import Data.Foldable      ( toList )
+import Data.List          ( partition, sort )
+import Data.List.NonEmpty ( NonEmpty(..) )
 
 {-
 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
@@ -1091,7 +1093,7 @@ okHsSig ctxt (L _ sig)
      (CompleteMatchSig {}, _)              -> False
 
 -------------------
-findDupSigs :: [LSig GhcPs] -> [[(Located RdrName, Sig GhcPs)]]
+findDupSigs :: [LSig GhcPs] -> [NonEmpty (Located RdrName, Sig GhcPs)]
 -- Check for duplicates on RdrName version,
 -- because renamed version has unboundName for
 -- not-in-scope binders, which gives bogus dup-sig errors
@@ -1162,14 +1164,13 @@ rnMatch' ctxt rnBody match@(Match { m_ctxt = mf, m_pats = pats
                 Nothing -> return ()
                 Just (L loc ty) -> addErrAt loc (resSigErr match ty)
 
-        ; let fixity = if isInfixMatch match then Infix else Prefix
                -- Now the main event
                -- Note that there are no local fixity decls for matches
         ; rnPats ctxt pats      $ \ pats' -> do
         { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
-        ; let mf' = case (ctxt,mf) of
-                      (FunRhs (L _ funid) _ _,FunRhs (L lf _) _ strict)
-                                            -> FunRhs (L lf funid) fixity strict
+        ; let mf' = case (ctxt, mf) of
+                      (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
+                                            -> mf { mc_fun = L lf funid }
                       _                     -> ctxt
         ; return (Match { m_ctxt = mf', m_pats = pats'
                         , m_type = Nothing, m_grhss = grhss'}, grhss_fvs ) }}
@@ -1244,17 +1245,18 @@ rnGRHS' ctxt rnBody (GRHS guards rhs)
 ************************************************************************
 -}
 
-dupSigDeclErr :: [(Located RdrName, Sig GhcPs)] -> RnM ()
-dupSigDeclErr pairs@((L loc name, sig) : _)
+dupSigDeclErr :: NonEmpty (Located RdrName, Sig GhcPs) -> RnM ()
+dupSigDeclErr pairs@((L loc name, sig) :| _)
   = addErrAt loc $
     vcat [ text "Duplicate" <+> what_it_is
            <> text "s for" <+> quotes (ppr name)
-         , text "at" <+> vcat (map ppr $ sort $ map (getLoc . fst) pairs) ]
+         , text "at" <+> vcat (map ppr $ sort
+                                       $ map (getLoc . fst)
+                                       $ toList pairs)
+         ]
   where
     what_it_is = hsSigDoc sig
 
-dupSigDeclErr [] = panic "dupSigDeclErr"
-
 misplacedSigErr :: LSig GhcRn -> RnM ()
 misplacedSigErr (L loc sig)
   = addErrAt loc $
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 617b3556bb..298de54168 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -53,7 +53,7 @@ import HscTypes
 import TcEnv
 import TcRnMonad
 import RdrHsSyn         ( setRdrNameSpace )
-import TysWiredIn       ( starKindTyConName, unicodeStarKindTyConName )
+import TysWiredIn
 import Name
 import NameSet
 import NameEnv
@@ -1573,5 +1573,17 @@ opDeclErr n
 
 badOrigBinding :: RdrName -> SDoc
 badOrigBinding name
-  = text "Illegal binding of built-in syntax:" <+> ppr (rdrNameOcc name)
-        -- The rdrNameOcc is because we don't want to print Prelude.(,)
+  | Just _ <- isBuiltInOcc_maybe occ
+  = text "Illegal binding of built-in syntax:" <+> ppr occ
+    -- Use an OccName here because we don't want to print Prelude.(,)
+  | otherwise
+  = text "Cannot redefine a Name retrieved by a Template Haskell quote:"
+    <+> ppr name
+    -- This can happen when one tries to use a Template Haskell splice to
+    -- define a top-level identifier with an already existing name, e.g.,
+    --
+    --   $(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
+    --
+    -- (See Trac #13968.)
+  where
+    occ = rdrNameOcc name
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 100ace3f24..45979ca10e 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -57,6 +57,7 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import Data.Ord
 import Data.Array
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -577,7 +578,7 @@ methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
 methodNamesMatch (MG { mg_alts = L _ ms })
   = plusFVs (map do_one ms)
  where
-    do_one (L _ (Match _ _ _ grhss)) = methodNamesGRHSs grhss
+    do_one (L _ (Match { m_grhss = grhss })) = methodNamesGRHSs grhss
 
 -------------------------------------------------
 -- gaw 2004
@@ -970,7 +971,7 @@ rnParallelStmts ctxt return_op segs thing_inside
 
     cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
     dupErr vs = addErr (text "Duplicate binding in parallel list comprehension for:"
-                    <+> quotes (ppr (head vs)))
+                    <+> quotes (ppr (NE.head vs)))
 
 lookupStmtName :: HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
 -- Like lookupSyntaxName, but respects contexts
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index ff88dbffbc..320e4f3d12 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -68,6 +68,7 @@ import DataCon
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad       ( when, liftM, ap, unless )
+import qualified Data.List.NonEmpty as NE
 import Data.Ratio
 
 {-
@@ -690,7 +691,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
         -- Data constructor not lexically in scope at all
         -- See Note [Disambiguation and Template Haskell]
 
-    dup_flds :: [[RdrName]]
+    dup_flds :: [NE.NonEmpty RdrName]
         -- Each list represents a RdrName that occurred more than once
         -- (the list contains all occurrences)
         -- Each list in dup_fields is non-empty
@@ -769,7 +770,7 @@ rnHsRecUpdFields flds
                                      , hsRecFieldArg = arg''
                                      , hsRecPun      = pun }), fvs') }
 
-    dup_flds :: [[RdrName]]
+    dup_flds :: [NE.NonEmpty RdrName]
         -- Each list represents a RdrName that occurred more than once
         -- (the list contains all occurrences)
         -- Each list in dup_fields is non-empty
@@ -803,10 +804,10 @@ badPun :: Located RdrName -> SDoc
 badPun fld = vcat [text "Illegal use of punning for field" <+> quotes (ppr fld),
                    text "Use NamedFieldPuns to permit this"]
 
-dupFieldErr :: HsRecFieldContext -> [RdrName] -> SDoc
+dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> SDoc
 dupFieldErr ctxt dups
   = hsep [text "duplicate field name",
-          quotes (ppr (head dups)),
+          quotes (ppr (NE.head dups)),
           text "in record", pprRFC ctxt]
 
 pprRFC :: HsRecFieldContext -> SDoc
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 1ffa6f1f3e..696bb0937e 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -64,7 +64,9 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Control.Arrow ( first )
-import Data.List ( sortBy, mapAccumL )
+import Data.List ( mapAccumL )
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty ( NonEmpty(..) )
 import Data.Maybe ( isJust )
 import qualified Data.Set as Set ( difference, fromList, toList, null )
 
@@ -321,7 +323,7 @@ rnSrcWarnDecls _ []
 
 rnSrcWarnDecls bndr_set decls'
   = do { -- check for duplicates
-       ; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
+       ; mapM_ (\ dups -> let (L loc rdr :| (lrdr':_)) = dups
                           in addErrAt loc (dupWarnDecl lrdr' rdr))
                warn_rdr_dups
        ; pairs_s <- mapM (addLocM rn_deprec) decls
@@ -342,7 +344,7 @@ rnSrcWarnDecls bndr_set decls'
    warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning ns _)) -> ns)
                                                decls
 
-findDupRdrNames :: [Located RdrName] -> [[Located RdrName]]
+findDupRdrNames :: [Located RdrName] -> [NonEmpty (Located RdrName)]
 findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
 
 -- look for duplicates among the OccNames;
@@ -746,11 +748,11 @@ rnFamInstDecl doc mb_cls tycon (HsIB { hsib_body = pats }) payload rnPayload
 
                        -- Report unused binders on the LHS
                        -- See Note [Unused type variables in family instances]
-                    ; let groups :: [[Located RdrName]]
+                    ; let groups :: [NonEmpty (Located RdrName)]
                           groups = equivClasses cmpLocated $
                                    freeKiTyVarsAllVars pat_kity_vars_with_dups
                     ; tv_nms_dups <- mapM (lookupOccRn . unLoc) $
-                                     [ tv | (tv:_:_) <- groups ]
+                                     [ tv | (tv :| (_:_)) <- groups ]
                           -- Add to the used variables
                           --  a) any variables that appear *more than once* on the LHS
                           --     e.g.   F a Int a = Bool
@@ -1531,16 +1533,15 @@ rnRoleAnnots tc_names role_annots
                                           tycon
            ; return $ RoleAnnotDecl tycon' roles }
 
-dupRoleAnnotErr :: [LRoleAnnotDecl GhcPs] -> RnM ()
-dupRoleAnnotErr [] = panic "dupRoleAnnotErr"
+dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM ()
 dupRoleAnnotErr list
   = addErrAt loc $
     hang (text "Duplicate role annotations for" <+>
           quotes (ppr $ roleAnnotDeclName first_decl) <> colon)
-       2 (vcat $ map pp_role_annot sorted_list)
+       2 (vcat $ map pp_role_annot $ NE.toList sorted_list)
     where
-      sorted_list = sortBy cmp_annot list
-      (L loc first_decl : _) = sorted_list
+      sorted_list = NE.sortBy cmp_annot list
+      (L loc first_decl :| _) = sorted_list
 
       pp_role_annot (L loc decl) = hang (ppr decl)
                                       4 (text "-- written at" <+> ppr loc)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index f648856fb7..83d28aadd6 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -62,8 +62,9 @@ import FastString
 import Maybes
 import qualified GHC.LanguageExtensions as LangExt
 
-import Data.List        ( nubBy, partition )
-import Control.Monad    ( unless, when )
+import Data.List          ( nubBy, partition )
+import Data.List.NonEmpty ( NonEmpty(..) )
+import Control.Monad      ( unless, when )
 
 #include "HsVersions.h"
 
@@ -974,7 +975,7 @@ bindLHsTyVarBndr doc mb_assoc kv_names tv_names hs_tv_bndr thing_inside
              addErrAt loc (vcat [ ki_ty_err_msg name
                                 , pprHsDocContext doc ])
            ; when (name `elemNameSet` tv_names) $
-             dupNamesErr getLoc [L loc name, L (nameSrcSpan name) name] }}
+             dupNamesErr getLoc (L loc name :| [L (nameSrcSpan name) name]) }}
 
     ki_ty_err_msg n = text "Variable" <+> quotes (ppr n) <+>
                       text "used as a kind variable before being bound" $$
@@ -1346,7 +1347,7 @@ checkPrecMatch :: Name -> MatchGroup GhcRn body -> RnM ()
 checkPrecMatch op (MG { mg_alts = L _ ms })
   = mapM_ check ms
   where
-    check (L _ (Match _ (L l1 p1 : L l2 p2 :_) _ _))
+    check (L _ (Match { m_pats = L l1 p1 : L l2 p2 :_ }))
       = setSrcSpan (combineSrcSpans l1 l2) $
         do checkPrec op p1 False
            checkPrec op p2 True
@@ -1717,11 +1718,25 @@ extract_hs_tv_bndrs tvs
   = do { FKTV bndr_kvs _
            <- foldrM extract_lkind emptyFKTV [k | L _ (KindedTyVar _ k) <- tvs]
 
-       ; let locals = map hsLTyVarName tvs
+       ; let locals = map hsLTyVarLocName tvs
+
+         -- These checks are all tested in typecheck/should_fail/T11963
+       ; check_for_mixed_vars bndr_kvs acc_tvs
+       ; check_for_mixed_vars bndr_kvs body_tvs
+       ; check_for_mixed_vars body_tvs acc_kvs
+       ; check_for_mixed_vars body_kvs acc_tvs
+       ; check_for_mixed_vars locals body_kvs
+
        ; return $
-         FKTV (filterOut ((`elem` locals) . unLoc) (bndr_kvs ++ body_kvs)
+         FKTV (filterOut (`elemRdr` locals) (bndr_kvs ++ body_kvs)
                 ++ acc_kvs)
-              (filterOut ((`elem` locals) . unLoc)  body_tvs ++ acc_tvs) }
+              (filterOut (`elemRdr` locals) body_tvs ++ acc_tvs) }
+  where
+    check_for_mixed_vars :: [Located RdrName] -> [Located RdrName] -> RnM ()
+    check_for_mixed_vars tvs1 tvs2 = mapM_ check tvs1
+      where
+        check tv1 = when (isRdrTyVar (unLoc tv1) && (tv1 `elemRdr` tvs2)) $
+                    mixedVarsErr tv1
 
 extract_tv :: TypeOrKind -> Located RdrName -> FreeKiTyVars
            -> RnM FreeKiTyVars
@@ -1737,8 +1752,6 @@ extract_tv t_or_k ltv@(L _ tv) acc
                 mixedVarsErr ltv
               ; return (FKTV (ltv : kvs) tvs) }
   | otherwise     = return acc
-  where
-    elemRdr x = any (eqLocated x)
 
 mixedVarsErr :: Located RdrName -> RnM ()
 mixedVarsErr (L loc tv)
@@ -1751,3 +1764,6 @@ mixedVarsErr (L loc tv)
 -- just used in this module; seemed convenient here
 nubL :: Eq a => [Located a] -> [Located a]
 nubL = nubBy eqLocated
+
+elemRdr :: Located RdrName -> [Located RdrName] -> Bool
+elemRdr x = any (eqLocated x)
diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs
index 7b2f74f1da..50598f8b49 100644
--- a/compiler/rename/RnUtils.hs
+++ b/compiler/rename/RnUtils.hs
@@ -45,6 +45,7 @@ import FastString
 import Control.Monad
 import Data.List
 import Constants        ( mAX_TUPLE_SIZE )
+import qualified Data.List.NonEmpty as NE
 import qualified GHC.LanguageExtensions as LangExt
 
 {-
@@ -316,13 +317,13 @@ unknownSubordinateErr doc op    -- Doc is "method of class" or
   = quotes (ppr op) <+> text "is not a (visible)" <+> doc
 
 
-dupNamesErr :: Outputable n => (n -> SrcSpan) -> [n] -> RnM ()
+dupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM ()
 dupNamesErr get_loc names
   = addErrAt big_loc $
-    vcat [text "Conflicting definitions for" <+> quotes (ppr (head names)),
+    vcat [text "Conflicting definitions for" <+> quotes (ppr (NE.head names)),
           locations]
   where
-    locs      = map get_loc names
+    locs      = map get_loc (NE.toList names)
     big_loc   = foldr1 combineSrcSpans locs
     locations = text "Bound at:" <+> vcat (map ppr (sort locs))
 
diff --git a/compiler/simplCore/CSE.hs b/compiler/simplCore/CSE.hs
index 83f5ee6a3b..ccbdf3537d 100644
--- a/compiler/simplCore/CSE.hs
+++ b/compiler/simplCore/CSE.hs
@@ -454,7 +454,7 @@ cseExpr _   (Lit lit)             = Lit lit
 cseExpr env (Var v)               = lookupSubst env v
 cseExpr env (App f a)             = App (cseExpr env f) (tryForCSE env a)
 cseExpr env (Tick t e)            = Tick t (cseExpr env e)
-cseExpr env (Cast e co)           = Cast (cseExpr env e) (substCo (csEnvSubst env) co)
+cseExpr env (Cast e co)           = Cast (tryForCSE env e) (substCo (csEnvSubst env) co)
 cseExpr env (Lam b e)             = let (env', b') = addBinder env b
                                     in Lam b' (cseExpr env' e)
 cseExpr env (Let bind e)          = let (env', bind') = cseBind NotTopLevel env bind
diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index 0cf0c2f44f..e41e5bdef9 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -350,7 +350,7 @@ Note [Thunks in recursive groups]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
 We never eta-expand a thunk in a recursive group, on the grounds that if it is
-part of a recursive group, then it will be called multipe times.
+part of a recursive group, then it will be called multiple times.
 
 This is not necessarily true, e.g.  it would be safe to eta-expand t2 (but not
 t1) in the following code:
diff --git a/compiler/simplCore/OccurAnal.hs b/compiler/simplCore/OccurAnal.hs
index 5dd30aa668..dbe1c48828 100644
--- a/compiler/simplCore/OccurAnal.hs
+++ b/compiler/simplCore/OccurAnal.hs
@@ -2657,12 +2657,9 @@ tagRecBinders lvl body_uds triples
      -- 3. Compute final usage details from adjusted RHS details
      adj_uds   = body_uds +++ combineUsageDetailsList rhs_udss'
 
-     -- 4. Tag each binder with its adjusted details modulo the
-     --    join-point-hood decision
-     occs      = map (lookupDetails adj_uds) bndrs
-     occs'     | will_be_joins = occs
-               | otherwise     = map markNonTailCalled occs
-     bndrs'    = zipWith setBinderOcc occs' bndrs
+     -- 4. Tag each binder with its adjusted details
+     bndrs'    = [ setBinderOcc (lookupDetails adj_uds bndr) bndr
+                 | bndr <- bndrs ]
 
      -- 5. Drop the binders from the adjusted details and return
      usage'    = adj_uds `delDetailsList` bndrs
diff --git a/compiler/simplCore/SimplUtils.hs b/compiler/simplCore/SimplUtils.hs
index e6e660b91f..b01955c8be 100644
--- a/compiler/simplCore/SimplUtils.hs
+++ b/compiler/simplCore/SimplUtils.hs
@@ -1785,7 +1785,7 @@ prepareAlts scrut case_bndr' alts
 mkCase tries these things
 
 * Note [Nerge nested cases]
-* Note [Elimiante identity case]
+* Note [Eliminate identity case]
 * Note [Scrutinee constant folding]
 
 Note [Merge Nested Cases]
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs
index 91ed644057..1fc9112fcf 100644
--- a/compiler/simplCore/Simplify.hs
+++ b/compiler/simplCore/Simplify.hs
@@ -566,7 +566,6 @@ That's what the 'go' loop in prepareRhs does
 prepareRhs :: TopLevelFlag -> SimplEnv -> OutId -> OutExpr -> SimplM (SimplEnv, OutExpr)
 -- See Note [prepareRhs]
 -- Adds new floats to the env iff that allows us to return a good RHS
--- See Note [prepareRhs]
 prepareRhs top_lvl env id (Cast rhs co)    -- Note [Float coercions]
   | Pair ty1 _ty2 <- coercionKind co       -- Do *not* do this if rhs has an unlifted type
   , not (isUnliftedType ty1)            -- see Note [Float coercions (unlifted)]
@@ -2700,7 +2699,7 @@ Note [Add unfolding for scrutinee]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 In general it's unlikely that a variable scrutinee will appear
 in the case alternatives   case x of { ...x unlikely to appear... }
-because the binder-swap in OccAnal has got rid of all such occcurrences
+because the binder-swap in OccAnal has got rid of all such occurrences
 See Note [Binder swap] in OccAnal.
 
 BUT it is still VERY IMPORTANT to add a suitable unfolding for a
diff --git a/compiler/simplStg/StgCse.hs b/compiler/simplStg/StgCse.hs
index 6bd6adc7ec..b221902768 100644
--- a/compiler/simplStg/StgCse.hs
+++ b/compiler/simplStg/StgCse.hs
@@ -5,9 +5,9 @@ Note [CSE for Stg]
 ~~~~~~~~~~~~~~~~~~
 This module implements a simple common subexpression elimination pass for STG.
 This is useful because there are expressions that we want to common up (because
-they are operational equivalent), but that we cannot common up in Core, because
+they are operationally equivalent), but that we cannot common up in Core, because
 their types differ.
-This was original reported as #9291.
+This was originally reported as #9291.
 
 There are two types of common code occurrences that we aim for, see
 note [Case 1: CSEing allocated closures] and
@@ -16,7 +16,7 @@ note [Case 2: CSEing case binders] below.
 
 Note [Case 1: CSEing allocated closures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The fist kind of CSE opportunity we aim for is generated by this Haskell code:
+The first kind of CSE opportunity we aim for is generated by this Haskell code:
 
     bar :: a -> (Either Int a, Either Bool a)
     bar x = (Right x, Right x)
@@ -137,7 +137,7 @@ data CseEnv = CseEnv
         --   * If we remove `let x = Con z` because  `let y = Con z` is in scope,
         --     we note this here as x ↦ y.
     , ce_bndrMap     :: IdEnv OutId
-        --   If we come across a case expression case x as b of … with a trivial
+        -- ^ If we come across a case expression case x as b of … with a trivial
         --   binder, we add b ↦ x to this.
         --   This map is *only* used when looking something up in the ce_conAppMap.
         --   See Note [Trivial case scrutinee]
@@ -217,7 +217,7 @@ substVar env id = fromMaybe id $ lookupVarEnv (ce_subst env) id
 
 -- Functions to enter binders
 
--- This is much simpler than the requivalent code in CoreSubst:
+-- This is much simpler than the equivalent code in CoreSubst:
 --  * We do not substitute type variables, and
 --  * There is nothing relevant in IdInfo at this stage
 --    that needs substitutions.
@@ -438,7 +438,7 @@ we first replace v with r2. Next we want to replace Right r2 with r1. But the
 ce_conAppMap contains Right a!
 
 Therefore, we add r1 ↦ x to ce_bndrMap when analysing the outer case, and use
-this subsitution before looking Right r2 up in ce_conAppMap, and everything
+this substitution before looking Right r2 up in ce_conAppMap, and everything
 works out.
 
 Note [Free variables of an StgClosure]
diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs
index 869da640ea..0fb7eb0472 100644
--- a/compiler/specialise/Specialise.hs
+++ b/compiler/specialise/Specialise.hs
@@ -43,9 +43,7 @@ import State
 import UniqDFM
 
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 
 {-
 ************************************************************************
@@ -147,7 +145,7 @@ becomes
                          in
                          fl
 
-We still have recusion for non-overloaded functions which we
+We still have recursion for non-overloaded functions which we
 specialise, but the recursive call should get specialised to the
 same recursive version.
 
@@ -2289,10 +2287,8 @@ instance Monad SpecM where
                                        z
     fail str = SpecM $ fail str
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail SpecM where
     fail str = SpecM $ fail str
-#endif
 
 instance MonadUnique SpecM where
     getUniqueSupplyM
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs
index 20c3d5cbb9..34e6e71d46 100644
--- a/compiler/typecheck/Inst.hs
+++ b/compiler/typecheck/Inst.hs
@@ -33,7 +33,7 @@ module Inst (
 #include "HsVersions.h"
 
 import {-# SOURCE #-}   TcExpr( tcPolyExpr, tcSyntaxOp )
-import {-# SOURCE #-}   TcUnify( unifyType, unifyKind, noThing )
+import {-# SOURCE #-}   TcUnify( unifyType, unifyKind )
 
 import BasicTypes ( IntegralLit(..), SourceText(..) )
 import FastString
@@ -324,13 +324,13 @@ instCallConstraints orig preds
   where
     go pred
      | Just (Nominal, ty1, ty2) <- getEqPredTys_maybe pred -- Try short-cut #1
-     = do  { co <- unifyType noThing ty1 ty2
+     = do  { co <- unifyType Nothing ty1 ty2
            ; return (EvCoercion co) }
 
        -- Try short-cut #2
      | Just (tc, args@[_, _, ty1, ty2]) <- splitTyConApp_maybe pred
      , tc `hasKey` heqTyConKey
-     = do { co <- unifyType noThing ty1 ty2
+     = do { co <- unifyType Nothing ty1 ty2
           ; return (EvDFunApp (dataConWrapId heqDataCon) args [EvCoercion co]) }
 
      | otherwise
@@ -407,9 +407,10 @@ tcInstBinder _ subst (Anon ty)
   | Just (mk, role, k1, k2) <- get_pred_tys_maybe substed_ty
   = do { let origin = TypeEqOrigin { uo_actual   = k1
                                    , uo_expected = k2
-                                   , uo_thing    = Nothing }
+                                   , uo_thing    = Nothing
+                                   , uo_visible  = True }
        ; co <- case role of
-                 Nominal          -> unifyKind noThing k1 k2
+                 Nominal          -> unifyKind Nothing k1 k2
                  Representational -> emitWantedEq origin KindLevel role k1 k2
                  Phantom          -> pprPanic "tcInstBinder Phantom" (ppr ty)
        ; arg' <- mk co k1 k2
diff --git a/compiler/typecheck/TcArrows.hs b/compiler/typecheck/TcArrows.hs
index b72b9b193c..d56a8d8c74 100644
--- a/compiler/typecheck/TcArrows.hs
+++ b/compiler/typecheck/TcArrows.hs
@@ -239,7 +239,7 @@ tc_cmd env cmd@(HsCmdApp fun arg) (cmd_stk, res_ty)
 
 tc_cmd env
        (HsCmdLam (MG { mg_alts = L l [L mtch_loc
-                                   (match@(Match _ pats _maybe_rhs_sig grhss))],
+                                   (match@(Match { m_pats = pats, m_grhss = grhss }))],
                        mg_origin = origin }))
        (cmd_stk, res_ty)
   = addErrCtxt (pprMatchInCtxt match)        $
@@ -250,7 +250,8 @@ tc_cmd env
                              tcPats LambdaExpr pats (map mkCheckExpType arg_tys) $
                              tc_grhss grhss cmd_stk' (mkCheckExpType res_ty)
 
-        ; let match' = L mtch_loc (Match LambdaExpr pats' Nothing grhss')
+        ; let match' = L mtch_loc (Match { m_ctxt = LambdaExpr, m_pats = pats'
+                                         , m_type = Nothing, m_grhss = grhss' })
               arg_tys = map hsLPatType pats'
               cmd' = HsCmdLam (MG { mg_alts = L l [match'], mg_arg_tys = arg_tys
                                   , mg_res_ty = res_ty, mg_origin = origin })
@@ -275,7 +276,7 @@ tc_cmd env
 --              Do notation
 
 tc_cmd env (HsCmdDo (L l stmts) _) (cmd_stk, res_ty)
-  = do  { co <- unifyType noThing unitTy cmd_stk  -- Expecting empty argument stack
+  = do  { co <- unifyType Nothing unitTy cmd_stk  -- Expecting empty argument stack
         ; stmts' <- tcStmts ArrowExpr (tcArrDoStmt env) stmts res_ty
         ; return (mkHsCmdWrap (mkWpCastN co) (HsCmdDo (L l stmts') res_ty)) }
 
diff --git a/compiler/typecheck/TcBinds.hs b/compiler/typecheck/TcBinds.hs
index 4d3c5cb578..16d359c593 100644
--- a/compiler/typecheck/TcBinds.hs
+++ b/compiler/typecheck/TcBinds.hs
@@ -38,7 +38,7 @@ import FamInstEnv( normaliseType )
 import FamInst( tcGetFamInstEnvs )
 import TyCon
 import TcType
-import Type( mkStrLitTy, tidyOpenType, mkTyVarBinder, splitTyConApp_maybe)
+import Type( mkStrLitTy, tidyOpenType, splitTyConApp_maybe)
 import TysPrim
 import TysWiredIn( cTupleTyConName )
 import Id
@@ -67,6 +67,7 @@ import qualified GHC.LanguageExtensions as LangExt
 import ConLike
 
 import Control.Monad
+import Data.List.NonEmpty ( NonEmpty(..) )
 
 #include "HsVersions.h"
 
@@ -717,13 +718,18 @@ tcPolyCheck prag_fn
                              , bind_fvsf   = placeHolderNamesTc
                              , fun_tick    = funBindTicks nm_loc mono_id mod prag_sigs }
 
-             abs_bind = L loc $ AbsBindsSig
-                        { abs_sig_export  = poly_id
-                        , abs_tvs         = skol_tvs
-                        , abs_ev_vars     = ev_vars
-                        , abs_sig_prags   = SpecPrags spec_prags
-                        , abs_sig_ev_bind = ev_binds
-                        , abs_sig_bind    = L loc bind' }
+             export = ABE { abe_wrap = idHsWrapper
+                          , abe_poly  = poly_id
+                          , abe_mono  = mono_id
+                          , abe_prags = SpecPrags spec_prags }
+
+             abs_bind = L loc $
+                        AbsBinds { abs_tvsa      = skol_tvs
+                                 , abs_ev_varsa  = ev_vars
+                                 , abs_ev_binds = [ev_binds]
+                                 , abs_exports  = [export]
+                                 , abs_binds    = unitBag (L loc bind')
+                                 , abs_sig      = True }
 
        ; return (unitBag abs_bind, [poly_id]) }
 
@@ -787,19 +793,20 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
        ; mapM_ (checkOverloadedSig mono) sigs
 
        ; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted)
-       ; (qtvs, givens, ev_binds)
+       ; (qtvs, givens, ev_binds, insoluble)
                  <- simplifyInfer tclvl infer_mode sigs name_taus wanted
 
        ; let inferred_theta = map evVarPred givens
        ; exports <- checkNoErrs $
-                    mapM (mkExport prag_fn qtvs inferred_theta) mono_infos
+                    mapM (mkExport prag_fn insoluble qtvs inferred_theta) mono_infos
 
        ; loc <- getSrcSpanM
        ; let poly_ids = map abe_poly exports
              abs_bind = L loc $
                         AbsBinds { abs_tvsa = qtvs
                                  , abs_ev_varsa = givens, abs_ev_binds = [ev_binds]
-                                 , abs_exports = exports, abs_binds = binds' }
+                                 , abs_exports = exports, abs_binds = binds'
+                                 , abs_sig = False }
 
        ; traceTc "Binding:" (ppr (poly_ids `zip` map idType poly_ids))
        ; return (unitBag abs_bind, poly_ids) }
@@ -807,6 +814,8 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
 
 --------------
 mkExport :: TcPragEnv
+         -> Bool                        -- True <=> there was an insoluble type error
+                                        --          when typechecking the bindings
          -> [TyVar] -> TcThetaType      -- Both already zonked
          -> MonoBindInfo
          -> TcM (ABExport GhcTc)
@@ -823,12 +832,12 @@ mkExport :: TcPragEnv
 
 -- Pre-condition: the qtvs and theta are already zonked
 
-mkExport prag_fn qtvs theta
+mkExport prag_fn insoluble qtvs theta
          mono_info@(MBI { mbi_poly_name = poly_name
                         , mbi_sig       = mb_sig
                         , mbi_mono_id   = mono_id })
   = do  { mono_ty <- zonkTcType (idType mono_id)
-        ; poly_id <- mkInferredPolyId qtvs theta poly_name mb_sig mono_ty
+        ; poly_id <- mkInferredPolyId insoluble qtvs theta poly_name mb_sig mono_ty
 
         -- NB: poly_id has a zonked type
         ; poly_id <- addInlinePrags poly_id prag_sigs
@@ -856,17 +865,19 @@ mkExport prag_fn qtvs theta
 
         ; return (ABE { abe_wrap = wrap
                         -- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)
-                      , abe_poly = poly_id
-                      , abe_mono = mono_id
-                      , abe_prags = SpecPrags spec_prags}) }
+                      , abe_poly  = poly_id
+                      , abe_mono  = mono_id
+                      , abe_prags = SpecPrags spec_prags }) }
   where
     prag_sigs = lookupPragEnv prag_fn poly_name
     sig_ctxt  = InfSigCtxt poly_name
 
-mkInferredPolyId :: [TyVar] -> TcThetaType
+mkInferredPolyId :: Bool  -- True <=> there was an insoluble error when
+                          --          checking the binding group for this Id
+                 -> [TyVar] -> TcThetaType
                  -> Name -> Maybe TcIdSigInst -> TcType
                  -> TcM TcId
-mkInferredPolyId qtvs inferred_theta poly_name mb_sig_inst mono_ty
+mkInferredPolyId insoluble qtvs inferred_theta poly_name mb_sig_inst mono_ty
   | Just (TISI { sig_inst_sig = sig })  <- mb_sig_inst
   , CompleteSig { sig_bndr = poly_id } <- sig
   = return poly_id
@@ -894,9 +905,13 @@ mkInferredPolyId qtvs inferred_theta poly_name mb_sig_inst mono_ty
 
        ; traceTc "mkInferredPolyId" (vcat [ppr poly_name, ppr qtvs, ppr theta'
                                           , ppr inferred_poly_ty])
-       ; addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $
+       ; unless insoluble $
+         addErrCtxtM (mk_inf_msg poly_name inferred_poly_ty) $
          checkValidType (InfSigCtxt poly_name) inferred_poly_ty
          -- See Note [Validity of inferred types]
+         -- If we found an insoluble error in the function definition, don't
+         -- do this check; otherwise (Trac #14000) we may report an ambiguity
+         -- error for a rather bogus type.
 
        ; return (mkLocalIdOrCoVar poly_name inferred_poly_ty) }
 
@@ -1146,7 +1161,7 @@ tcVectDecls decls
        ; return decls'
        }
   where
-    reportVectDups (first:_second:_more)
+    reportVectDups (first :| (_second:_more))
       = addErrAt (getSrcSpan first) $
           text "Duplicate vectorisation declarations for" <+> ppr first
     reportVectDups _ = return ()
@@ -1603,7 +1618,7 @@ data GeneralisationPlan
 
   | CheckGen (LHsBind GhcRn) TcIdSigInfo
                         -- One FunBind with a signature
-                        -- Explicit generalisation; there is an AbsBindsSig
+                        -- Explicit generalisation
 
 -- A consequence of the no-AbsBinds choice (NoGen) is that there is
 -- no "polymorphic Id" and "monmomorphic Id"; there is just the one
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index be51914a27..7b259257c4 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -24,7 +24,6 @@ import FamInstEnv ( FamInstEnvs )
 import FamInst ( tcTopNormaliseNewTypeTF_maybe )
 import Var
 import VarEnv( mkInScopeSet )
-import VarSet( extendVarSetList )
 import Outputable
 import DynFlags( DynFlags )
 import NameSet
@@ -563,6 +562,22 @@ can_eq_nc' _flat rdr_env envs ev ReprEq ty1 ps_ty1 ty2 _
   | Just stuff2 <- tcTopNormaliseNewTypeTF_maybe envs rdr_env ty2
   = can_eq_newtype_nc ev IsSwapped  ty2 stuff2 ty1 ps_ty1
 
+-- Now, check for tyvars. This must happen before CastTy because we need
+-- to catch casted tyvars, as the flattener might produce these,
+-- due to the fact that flattened types have flattened kinds.
+-- See Note [Flattening].
+-- Note that there can be only one cast on the tyvar because this will
+-- run after the "get rid of casts" case of can_eq_nc' function on the
+-- not-yet-flattened types.
+-- NB: pattern match on True: we want only flat types sent to canEqTyVar.
+-- See also Note [No top-level newtypes on RHS of representational equalities]
+can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2
+  | Just (tv1, co1) <- getCastedTyVar_maybe ty1
+  = canEqTyVar ev eq_rel NotSwapped tv1 co1 ps_ty1 ty2 ps_ty2
+can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 ty2 ps_ty2
+  | Just (tv2, co2) <- getCastedTyVar_maybe ty2
+  = canEqTyVar ev eq_rel IsSwapped tv2 co2 ps_ty2 ty1 ps_ty1
+
 -- Then, get rid of casts
 can_eq_nc' flat _rdr_env _envs ev eq_rel (CastTy ty1 co1) _ ty2 ps_ty2
   = canEqCast flat ev eq_rel NotSwapped ty1 co1 ty2 ps_ty2
@@ -609,14 +624,6 @@ can_eq_nc' False rdr_env envs ev eq_rel _ ps_ty1 _ ps_ty2
          `andWhenContinue` \ new_ev ->
          can_eq_nc' True rdr_env envs new_ev eq_rel xi1 xi1 xi2 xi2 }
 
--- Type variable on LHS or RHS are last.
--- NB: pattern match on True: we want only flat types sent to canEqTyVar.
--- See also Note [No top-level newtypes on RHS of representational equalities]
-can_eq_nc' True _rdr_env _envs ev eq_rel (TyVarTy tv1) ps_ty1 ty2 ps_ty2
-  = canEqTyVar ev eq_rel NotSwapped tv1 ps_ty1 ty2 ps_ty2
-can_eq_nc' True _rdr_env _envs ev eq_rel ty1 ps_ty1 (TyVarTy tv2) ps_ty2
-  = canEqTyVar ev eq_rel IsSwapped tv2 ps_ty2 ty1 ps_ty1
-
 -- We've flattened and the types don't match. Give up.
 can_eq_nc' True _rdr_env _envs ev _eq_rel _ ps_ty1 _ ps_ty2
   = do { traceTcS "can_eq_nc' catch-all case" (ppr ps_ty1 $$ ppr ps_ty2)
@@ -636,8 +643,7 @@ can_eq_nc_forall :: CtEvidence -> EqRel
 
 can_eq_nc_forall ev eq_rel s1 s2
  | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev
- = do { let free_tvs1 = tyCoVarsOfType s1
-            free_tvs2 = tyCoVarsOfType s2
+ = do { let free_tvs       = tyCoVarsOfTypes [s1,s2]
             (bndrs1, phi1) = tcSplitForAllTyVarBndrs s1
             (bndrs2, phi2) = tcSplitForAllTyVarBndrs s2
       ; if not (equalLength bndrs1 bndrs2)
@@ -648,7 +654,7 @@ can_eq_nc_forall ev eq_rel s1 s2
                 ; canEqHardFailure ev s1 s2 }
         else
    do { traceTcS "Creating implication for polytype equality" $ ppr ev
-      ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs1
+      ; let empty_subst1 = mkEmptyTCvSubst $ mkInScopeSet free_tvs
       ; (subst1, skol_tvs) <- tcInstSkolTyVarsX empty_subst1 $
                               binderVars bndrs1
 
@@ -674,8 +680,7 @@ can_eq_nc_forall ev eq_rel s1 s2
 
             go _ _ _ = panic "cna_eq_nc_forall"  -- case (s:ss) []
 
-            empty_subst2 = mkEmptyTCvSubst $ mkInScopeSet $
-                           free_tvs2 `extendVarSetList` skol_tvs
+            empty_subst2 = mkEmptyTCvSubst (getTCvInScope subst1)
 
       ; (implic, _ev_binds, all_co) <- buildImplication skol_info skol_tvs [] $
                                        go skol_tvs empty_subst2 bndrs2
@@ -922,7 +927,10 @@ can_eq_app ev NomEq s1 t1 s2 t2
        ; stopWith ev "Decomposed [D] AppTy" }
   | CtWanted { ctev_dest = dest, ctev_loc = loc } <- ev
   = do { co_s <- unifyWanted loc Nominal s1 s2
-       ; co_t <- unifyWanted loc Nominal t1 t2
+       ; let arg_loc
+               | isNextArgVisible s1 = loc
+               | otherwise           = updateCtLocOrigin loc toInvisibleOrigin
+       ; co_t <- unifyWanted arg_loc Nominal t1 t2
        ; let co = mkAppCo co_s co_t
        ; setWantedEq dest co
        ; stopWith ev "Decomposed [W] AppTy" }
@@ -1216,13 +1224,16 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2
       -- the following makes a better distinction between "kind" and "type"
       -- in error messages
     bndrs      = tyConBinders tc
-    kind_loc   = toKindLoc loc
     is_kinds   = map isNamedTyConBinder bndrs
-    new_locs | Just KindLevel <- ctLocTypeOrKind_maybe loc
-             = repeat loc
-             | otherwise
-             = map (\is_kind -> if is_kind then kind_loc else loc) is_kinds
+    is_viss    = map isVisibleTyConBinder bndrs
+
+    kind_xforms = map (\is_kind -> if is_kind then toKindLoc else id) is_kinds
+    vis_xforms  = map (\is_vis  -> if is_vis  then id
+                                   else flip updateCtLocOrigin toInvisibleOrigin)
+                      is_viss
 
+    -- zipWith3 (.) composes its first two arguments and applies it to the third
+    new_locs = zipWith3 (.) kind_xforms vis_xforms (repeat loc)
 
 -- | Call when canonicalizing an equality fails, but if the equality is
 -- representational, there is some hope for the future.
@@ -1356,19 +1367,6 @@ isInsolubleOccursCheck does.
 
 See also #10715, which induced this addition.
 
-Note [No derived kind equalities]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we're working with a heterogeneous derived equality
-
-  [D] (t1 :: k1) ~ (t2 :: k2)
-
-we want to homogenise to establish the kind invariant on CTyEqCans.
-But we can't emit [D] k1 ~ k2 because we wouldn't then be able to
-use the evidence in the homogenised types. So we emit a wanted
-constraint, because we do really need the evidence here.
-
-Thus: no derived kind equalities.
-
 -}
 
 canCFunEqCan :: CtEvidence
@@ -1396,54 +1394,120 @@ canCFunEqCan ev fn tys fsk
 ---------------------
 canEqTyVar :: CtEvidence          -- ev :: lhs ~ rhs
            -> EqRel -> SwapFlag
-           -> TcTyVar -> TcType   -- lhs: already flat, not a cast
-           -> TcType -> TcType    -- rhs: already flat, not a cast
+           -> TcTyVar -> CoercionN  -- tv1 |> co1
+           -> TcType                -- lhs: pretty lhs, already flat
+           -> TcType -> TcType      -- rhs: already flat
            -> TcS (StopOrContinue Ct)
-canEqTyVar ev eq_rel swapped tv1 ps_ty1 (TyVarTy tv2) _
-  | tv1 == tv2
-  = canEqReflexive ev eq_rel ps_ty1
+canEqTyVar ev eq_rel swapped tv1 co1 ps_ty1 xi2 ps_xi2
+  | k1 `eqType` k2
+  = canEqTyVarHomo ev eq_rel swapped tv1 co1 ps_ty1 xi2 ps_xi2
+
+  -- See Note [Equalities with incompatible kinds]
+  | CtGiven { ctev_evar = evar } <- ev
+    -- unswapped: tm :: (lhs :: k1) ~ (rhs :: k2)
+    -- swapped  : tm :: (rhs :: k2) ~ (lhs :: k1)
+  = do { kind_ev_id <- newBoundEvVarId kind_pty
+                                       (EvCoercion $
+                                        if isSwapped swapped
+                                        then mkTcSymCo $ mkTcKindCo $ mkTcCoVarCo evar
+                                        else             mkTcKindCo $ mkTcCoVarCo evar)
+           -- kind_ev_id :: (k1 :: *) ~ (k2 :: *)   (whether swapped or not)
+       ; let kind_ev = CtGiven { ctev_pred = kind_pty
+                               , ctev_evar = kind_ev_id
+                               , ctev_loc  = kind_loc }
+             homo_co = mkSymCo $ mkCoVarCo kind_ev_id
+             rhs'    = mkCastTy xi2 homo_co
+             ps_rhs' = mkCastTy ps_xi2 homo_co
+       ; traceTcS "Hetero equality gives rise to given kind equality"
+           (ppr kind_ev_id <+> dcolon <+> ppr kind_pty)
+       ; emitWorkNC [kind_ev]
+       ; type_ev <- newGivenEvVar loc $
+                    if isSwapped swapped
+                    then ( mkTcEqPredLikeEv ev rhs' lhs
+                         , EvCoercion $
+                           mkTcCoherenceLeftCo (mkTcCoVarCo evar) homo_co )
+                    else ( mkTcEqPredLikeEv ev lhs rhs'
+                         , EvCoercion $
+                           mkTcCoherenceRightCo (mkTcCoVarCo evar) homo_co )
+          -- unswapped: type_ev :: (lhs :: k1) ~ ((rhs |> sym kind_ev_id) :: k1)
+          -- swapped  : type_ev :: ((rhs |> sym kind_ev_id) :: k1) ~ (lhs :: k1)
+       ; canEqTyVarHomo type_ev eq_rel swapped tv1 co1 ps_ty1 rhs' ps_rhs' }
+
+  -- See Note [Equalities with incompatible kinds]
+  | otherwise   -- Wanted and Derived
+                  -- NB: all kind equalities are Nominal
+  = do { emitNewDerivedEq kind_loc Nominal k1 k2
+             -- kind_ev :: (k1 :: *) ~ (k2 :: *)
+       ; traceTcS "Hetero equality gives rise to derived kind equality" $
+           ppr ev
+       ; continueWith (CIrredEvCan { cc_ev = ev }) }
+
+  where
+    lhs = mkTyVarTy tv1 `mkCastTy` co1
 
-  | swapOverTyVars tv1 tv2
+    Pair _ k1 = coercionKind co1
+    k2        = typeKind xi2
+
+    kind_pty = mkHeteroPrimEqPred liftedTypeKind liftedTypeKind k1 k2
+    kind_loc = mkKindLoc lhs xi2 loc
+
+    loc  = ctev_loc ev
+
+-- guaranteed that typeKind lhs == typeKind rhs
+canEqTyVarHomo :: CtEvidence
+               -> EqRel -> SwapFlag
+               -> TcTyVar -> CoercionN   -- lhs: tv1 |> co1
+               -> TcType                 -- pretty lhs
+               -> TcType -> TcType       -- rhs (might not be flat)
+               -> TcS (StopOrContinue Ct)
+canEqTyVarHomo ev eq_rel swapped tv1 co1 ps_ty1 ty2 _
+  | Just (tv2, _) <- tcGetCastedTyVar_maybe ty2
+  , tv1 == tv2
+  = canEqReflexive ev eq_rel (mkTyVarTy tv1 `mkCastTy` co1)
+    -- we don't need to check co2 because its type must match co1
+
+  | Just (tv2, co2) <- tcGetCastedTyVar_maybe ty2
+  , swapOverTyVars tv1 tv2
   = do { traceTcS "canEqTyVar" (ppr tv1 $$ ppr tv2 $$ ppr swapped)
          -- FM_Avoid commented out: see Note [Lazy flattening] in TcFlatten
          -- let fmode = FE { fe_ev = ev, fe_mode = FM_Avoid tv1' True }
          -- Flatten the RHS less vigorously, to avoid gratuitous flattening
          -- True <=> xi2 should not itself be a type-function application
        ; dflags <- getDynFlags
-       ; canEqTyVar2 dflags ev eq_rel (flipSwap swapped) tv2 ps_ty1 }
+       ; canEqTyVar2 dflags ev eq_rel (flipSwap swapped) tv2 co2 ps_ty1 }
 
-canEqTyVar ev eq_rel swapped tv1 _ _ ps_ty2
+canEqTyVarHomo ev eq_rel swapped tv1 co1 _ _ ps_ty2
   = do { dflags <- getDynFlags
-       ; canEqTyVar2 dflags ev eq_rel swapped tv1 ps_ty2 }
+       ; canEqTyVar2 dflags ev eq_rel swapped tv1 co1 ps_ty2 }
 
+-- The RHS here is either not a casted tyvar, or it's a tyvar but we want
+-- to rewrite the LHS to the RHS (as per swapOverTyVars)
 canEqTyVar2 :: DynFlags
             -> CtEvidence   -- lhs ~ rhs (or, if swapped, orhs ~ olhs)
             -> EqRel
             -> SwapFlag
-            -> TcTyVar      -- lhs, flat
-            -> TcType       -- rhs, flat
+            -> TcTyVar -> CoercionN     -- lhs = tv |> co, flat
+            -> TcType                   -- rhs
             -> TcS (StopOrContinue Ct)
 -- LHS is an inert type variable,
 -- and RHS is fully rewritten, but with type synonyms
 -- preserved as much as possible
-
-canEqTyVar2 dflags ev eq_rel swapped tv1 xi2
-  | Just xi2' <- metaTyVarUpdateOK dflags tv1 xi2  -- No occurs check
+canEqTyVar2 dflags ev eq_rel swapped tv1 co1 orhs
+  | Just nrhs' <- metaTyVarUpdateOK dflags tv1 nrhs  -- No occurs check
      -- Must do the occurs check even on tyvar/tyvar
      -- equalities, in case have  x ~ (y :: ..x...)
      -- Trac #12593
-  = rewriteEqEvidence ev swapped xi1 xi2' co1 co2
+  = rewriteEqEvidence ev swapped nlhs nrhs' rewrite_co1 rewrite_co2
     `andWhenContinue` \ new_ev ->
-    homogeniseRhsKind new_ev eq_rel xi1 xi2' $ \new_new_ev xi2'' ->
-    CTyEqCan { cc_ev = new_new_ev, cc_tyvar = tv1
-             , cc_rhs = xi2'', cc_eq_rel = eq_rel }
+    continueWith (CTyEqCan { cc_ev = new_ev, cc_tyvar = tv1
+                           , cc_rhs = nrhs', cc_eq_rel = eq_rel })
 
   | otherwise  -- For some reason (occurs check, or forall) we can't unify
                -- We must not use it for further rewriting!
-  = do { traceTcS "canEqTyVar2 can't unify" (ppr tv1 $$ ppr xi2)
-       ; rewriteEqEvidence ev swapped xi1 xi2 co1 co2
+  = do { traceTcS "canEqTyVar2 can't unify" (ppr tv1 $$ ppr nrhs)
+       ; rewriteEqEvidence ev swapped nlhs nrhs rewrite_co1 rewrite_co2
          `andWhenContinue` \ new_ev ->
-         if isInsolubleOccursCheck eq_rel tv1 xi2
+         if isInsolubleOccursCheck eq_rel tv1 nrhs
          then do { emitInsoluble (mkNonCanonical new_ev)
              -- If we have a ~ [a], it is not canonical, and in particular
              -- we don't want to rewrite existing inerts with it, otherwise
@@ -1457,13 +1521,18 @@ canEqTyVar2 dflags ev eq_rel swapped tv1 xi2
              -- But, the occurs-check certainly prevents the equality from being
              -- canonical, and we might loop if we were to use it in rewriting.
          else do { traceTcS "Possibly-soluble occurs check"
-                           (ppr xi1 $$ ppr xi2)
+                           (ppr nlhs $$ ppr nrhs)
                  ; continueWith (CIrredEvCan { cc_ev = new_ev }) } }
   where
     role = eqRelRole eq_rel
-    xi1  = mkTyVarTy tv1
-    co1  = mkTcReflCo role xi1
-    co2  = mkTcReflCo role xi2
+
+    nlhs = mkTyVarTy tv1
+    nrhs = orhs `mkCastTy` mkTcSymCo co1
+
+    -- rewrite_co1 :: tv1 ~ (tv1 |> co1)
+    -- rewrite_co2 :: (rhs |> sym co1) ~ rhs
+    rewrite_co1  = mkTcReflCo role nlhs `mkTcCoherenceRightCo` co1
+    rewrite_co2  = mkTcReflCo role orhs `mkTcCoherenceLeftCo`  mkTcSymCo co1
 
 -- | Solve a reflexive equality constraint
 canEqReflexive :: CtEvidence    -- ty ~ ty
@@ -1475,75 +1544,6 @@ canEqReflexive ev eq_rel ty
                                mkTcReflCo (eqRelRole eq_rel) ty)
        ; stopWith ev "Solved by reflexivity" }
 
--- See Note [Equalities with incompatible kinds]
-homogeniseRhsKind :: CtEvidence -- ^ the evidence to homogenise
-                  -> EqRel
-                  -> TcType              -- ^ original LHS
-                  -> Xi                  -- ^ original RHS
-                  -> (CtEvidence -> Xi -> Ct)
-                           -- ^ how to build the homogenised constraint;
-                           -- the 'Xi' is the new RHS
-                  -> TcS (StopOrContinue Ct)
-homogeniseRhsKind ev eq_rel lhs rhs build_ct
-  | k1 `tcEqType` k2
-  = continueWith (build_ct ev rhs)
-
-  | CtGiven { ctev_evar = evar } <- ev
-    -- tm :: (lhs :: k1) ~ (rhs :: k2)
-  = do { kind_ev_id <- newBoundEvVarId kind_pty
-                                       (EvCoercion $
-                                        mkTcKindCo $ mkTcCoVarCo evar)
-           -- kind_ev_id :: (k1 :: *) ~# (k2 :: *)
-       ; let kind_ev = CtGiven { ctev_pred = kind_pty
-                               , ctev_evar = kind_ev_id
-                               , ctev_loc  = kind_loc }
-             homo_co = mkSymCo $ mkCoVarCo kind_ev_id
-             rhs'    = mkCastTy rhs homo_co
-       ; traceTcS "Hetero equality gives rise to given kind equality"
-           (ppr kind_ev_id <+> dcolon <+> ppr kind_pty)
-       ; emitWorkNC [kind_ev]
-       ; type_ev <- newGivenEvVar loc
-                      ( mkTcEqPredLikeEv ev lhs rhs'
-                      , EvCoercion $
-                        mkTcCoherenceRightCo (mkTcCoVarCo evar) homo_co )
-          -- type_ev :: (lhs :: k1) ~ ((rhs |> sym kind_ev_id) :: k1)
-       ; continueWith (build_ct type_ev rhs') }
-
-  | otherwise   -- Wanted and Derived. See Note [No derived kind equalities]
-    -- evar :: (lhs :: k1) ~ (rhs :: k2)
-  = do { kind_co <- emitNewWantedEq kind_loc Nominal k1 k2
-             -- kind_ev :: (k1 :: *) ~ (k2 :: *)
-       ; traceTcS "Hetero equality gives rise to wanted kind equality" $
-           ppr (kind_co)
-       ; let homo_co   = mkSymCo kind_co
-           -- homo_co :: k2 ~ k1
-             rhs'      = mkCastTy rhs homo_co
-       ; case ev of
-           CtGiven {} -> panic "homogeniseRhsKind"
-           CtDerived {} -> continueWith (build_ct (ev { ctev_pred = homo_pred })
-                                                  rhs')
-             where homo_pred = mkTcEqPredLikeEv ev lhs rhs'
-           CtWanted { ctev_dest = dest } -> do
-             { (type_ev, hole_co) <- newWantedEq loc role lhs rhs'
-                  -- type_ev :: (lhs :: k1) ~ (rhs |> sym kind_co :: k1)
-             ; setWantedEq dest
-                           (hole_co `mkTransCo`
-                            (mkReflCo role rhs
-                             `mkCoherenceLeftCo` homo_co))
-
-                -- dest := hole ; <rhs> |> homo_co :: (lhs :: k1) ~ (rhs :: k2)
-             ; continueWith (build_ct type_ev rhs') }}
-
-  where
-    k1 = typeKind lhs
-    k2 = typeKind rhs
-
-    kind_pty = mkHeteroPrimEqPred liftedTypeKind liftedTypeKind k1 k2
-    kind_loc = mkKindLoc lhs rhs loc
-
-    loc  = ctev_loc ev
-    role = eqRelRole eq_rel
-
 {-
 Note [Canonical orientation for tyvar/tyvar equality constraints]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1605,21 +1605,66 @@ the fsk.
 
 Note [Equalities with incompatible kinds]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-canEqLeaf is about to make a CTyEqCan or CFunEqCan; but both have the
-invariant that LHS and RHS satisfy the kind invariants for CTyEqCan,
-CFunEqCan.  What if we try to unify two things with incompatible
-kinds?
+What do we do when we have an equality
+
+  (tv :: k1) ~ (rhs :: k2)
+
+where k1 and k2 differ? This Note explores this treacherous area.
+
+First off, the question above is slightly the wrong question. Flattening
+a tyvar will flatten its kind (Note [Flattening] in TcFlatten); flattening
+the kind might introduce a cast. So we might have a casted tyvar on the
+left. We thus revise our test case to
+
+  (tv |> co :: k1) ~ (rhs :: k2)
+
+We must proceed differently here depending on whether we have a Wanted
+or a Given. Consider this:
+
+ [W] w :: (alpha :: k) ~ (Int :: Type)
+
+where k is a skolem. One possible way forward is this:
+
+ [W] co :: k ~ Type
+ [W] w :: (alpha :: k) ~ (Int |> sym co :: k)
+
+The next step will be to unify
+
+  alpha := Int |> sym co
+
+Now, consider what error we'll report if we can't solve the "co"
+wanted. Its CtOrigin is the w wanted... which now reads (after zonking)
+Int ~ Int. The user thus sees that GHC can't solve Int ~ Int, which
+is embarrassing. See #11198 for more tales of destruction.
+
+The reason for this odd behavior is much the same as
+Note [Wanteds do not rewrite Wanteds] in TcRnTypes: note that the
+new `co` is a Wanted. The solution is then not to use `co` to "rewrite"
+-- that is, cast -- `w`, but instead to keep `w` heterogeneous and irreducible.
+Given that we're not using `co`, there is no reason to collect evidence
+for it, so `co` is born a Derived. When the Derived is solved (by unification),
+the original wanted (`w`) will get kicked out.
+
+Note that, if we had [G] co1 :: k ~ Type available, then none of this code would
+trigger, because flattening would have rewritten k to Type. That is,
+`w` would look like [W] (alpha |> co1 :: Type) ~ (Int :: Type), and the tyvar
+case will trigger, correctly rewriting alpha to (Int |> sym co1).
 
-eg    a ~ b  where a::*, b::*->*
-or    a ~ b  where a::*, b::k, k is a kind variable
+Successive canonicalizations of the same Wanted may produce
+duplicate Deriveds. Similar duplications can happen with fundeps, and there
+seems to be no easy way to avoid. I expect this case to be rare.
 
-The CTyEqCan compatKind invariant is important.  If we make a CTyEqCan
-for a~b, then we might well *substitute* 'b' for 'a', and that might make
-a well-kinded type ill-kinded; and that is bad (eg typeKind can crash, see
-Trac #7696).
+For Givens, this problem doesn't bite, so a heterogeneous Given gives
+rise to a Given kind equality. No Deriveds here. We thus homogenise
+the Given (see the "homo_co" in the Given case in canEqTyVar) and
+carry on with a homogeneous equality constraint.
 
-So instead for these ill-kinded equalities we homogenise the RHS of the
-equality, emitting new constraints as necessary.
+Separately, I (Richard E) spent some time pondering what to do in the case
+that we have [W] (tv |> co1 :: k1) ~ (tv |> co2 :: k2) where k1 and k2
+differ. Note that the tv is the same. (This case is handled as the first
+case in canEqTyVarHomo.) At one point, I thought we could solve this limited
+form of heterogeneous Wanted, but I then reconsidered and now treat this case
+just like any other heterogeneous Wanted.
 
 Note [Type synonyms and canonicalization]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/typecheck/TcClassDcl.hs b/compiler/typecheck/TcClassDcl.hs
index c420f900c6..4531d0f9ce 100644
--- a/compiler/typecheck/TcClassDcl.hs
+++ b/compiler/typecheck/TcClassDcl.hs
@@ -14,6 +14,7 @@ module TcClassDcl ( tcClassSigs, tcClassDecl2,
                     tcClassMinimalDef,
                     HsSigFun, mkHsSigFun,
                     tcMkDeclCtxt, tcAddDeclCtxt, badMethodErr,
+                    instDeclCtxt1, instDeclCtxt2, instDeclCtxt3,
                     tcATDefault
                   ) where
 
@@ -278,14 +279,15 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn
                               (L bind_loc lm_bind)
 
        ; let export = ABE { abe_poly   = global_dm_id
-                           , abe_mono  = local_dm_id
-                           , abe_wrap  = idHsWrapper
-                           , abe_prags = IsDefaultMethod }
-             full_bind = AbsBinds { abs_tvsa     = tyvars
-                                  , abs_ev_varsa = [this_dict]
+                          , abe_mono  = local_dm_id
+                          , abe_wrap  = idHsWrapper
+                          , abe_prags = IsDefaultMethod }
+             full_bind = AbsBinds { abs_tvsa      = tyvars
+                                  , abs_ev_varsa  = [this_dict]
                                   , abs_exports  = [export]
                                   , abs_ev_binds = [ev_binds]
-                                  , abs_binds    = tc_bind }
+                                  , abs_binds    = tc_bind
+                                  , abs_sig      = True }
 
        ; return (unitBag (L bind_loc full_bind)) }
 
@@ -460,9 +462,25 @@ warningMinimalDefIncomplete mindef
          , nest 2 (pprBooleanFormulaNice mindef)
          , text "but there is no default implementation." ]
 
-tcATDefault :: Bool -- If a warning should be emitted when a default instance
-                    -- definition is not provided by the user
-            -> SrcSpan
+instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
+instDeclCtxt1 hs_inst_ty
+  = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty))
+
+instDeclCtxt2 :: Type -> SDoc
+instDeclCtxt2 dfun_ty
+  = instDeclCtxt3 cls tys
+  where
+    (_,_,cls,tys) = tcSplitDFunTy dfun_ty
+
+instDeclCtxt3 :: Class -> [Type] -> SDoc
+instDeclCtxt3 cls cls_tys
+  = inst_decl_ctxt (ppr (mkClassPred cls cls_tys))
+
+inst_decl_ctxt :: SDoc -> SDoc
+inst_decl_ctxt doc = hang (text "In the instance declaration for")
+                        2 (quotes doc)
+
+tcATDefault :: SrcSpan
             -> TCvSubst
             -> NameSet
             -> ClassATItem
@@ -470,7 +488,7 @@ tcATDefault :: Bool -- If a warning should be emitted when a default instance
 -- ^ Construct default instances for any associated types that
 -- aren't given a user definition
 -- Returns [] or singleton
-tcATDefault emit_warn loc inst_subst defined_ats (ATI fam_tc defs)
+tcATDefault loc inst_subst defined_ats (ATI fam_tc defs)
   -- User supplied instances ==> everything is OK
   | tyConName fam_tc `elemNameSet` defined_ats
   = return []
@@ -502,7 +520,7 @@ tcATDefault emit_warn loc inst_subst defined_ats (ATI fam_tc defs)
 
    -- No defaults ==> generate a warning
   | otherwise  -- defs = Nothing
-  = do { when emit_warn $ warnMissingAT (tyConName fam_tc)
+  = do { warnMissingAT (tyConName fam_tc)
        ; return [] }
   where
     subst_tv subst tc_tv
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 96c7764c7d..82f17c201e 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -21,7 +21,7 @@ import FamInst
 import TcDerivInfer
 import TcDerivUtils
 import TcValidity( allDistinctTyVars )
-import TcClassDcl( tcATDefault, tcMkDeclCtxt )
+import TcClassDcl( instDeclCtxt3, tcATDefault, tcMkDeclCtxt )
 import TcEnv
 import TcGenDeriv                       -- Deriv stuff
 import InstEnv
@@ -1600,8 +1600,9 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
                  , ds_mechanism = mechanism, ds_tys = tys
                  , ds_cls = clas, ds_loc = loc })
   = do (meth_binds, deriv_stuff, unusedNames)
-         <- genDerivStuff mechanism loc clas rep_tycon tys tvs
-       let mk_inst_info theta = do
+         <- set_span_and_ctxt $
+            genDerivStuff mechanism loc clas rep_tycon tys tvs
+       let mk_inst_info theta = set_span_and_ctxt $ do
              inst_spec <- newDerivClsInst theta spec
              doDerivInstErrorChecks2 clas inst_spec mechanism
              traceTc "newder" (ppr inst_spec)
@@ -1624,6 +1625,9 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
       | otherwise
       = []
 
+    set_span_and_ctxt :: TcM a -> TcM a
+    set_span_and_ctxt = setSrcSpan loc . addErrCtxt (instDeclCtxt3 clas tys)
+
 doDerivInstErrorChecks1 :: Class -> [Type] -> TyCon -> [Type] -> TyCon
                         -> DerivContext -> Bool -> DerivSpecMechanism
                         -> TcM ()
@@ -1665,10 +1669,8 @@ doDerivInstErrorChecks2 clas clas_inst mechanism
       DerivSpecStock{} -> False
       _                -> True
 
-    gen_inst_err = hang (text ("Generic instances can only be derived in "
-                            ++ "Safe Haskell using the stock strategy.") $+$
-                         text "In the following instance:")
-                      2 (pprInstanceHdr clas_inst)
+    gen_inst_err = text "Generic instances can only be derived in"
+               <+> text "Safe Haskell using the stock strategy."
 
 genDerivStuff :: DerivSpecMechanism -> SrcSpan -> Class
               -> TyCon -> [Type] -> [TyVar]
@@ -1694,7 +1696,7 @@ genDerivStuff mechanism loc clas tycon inst_tys tyvars
           -- unless -XDeriveAnyClass is enabled.
           ASSERT2( isValid (canDeriveAnyClass dflags)
                  , ppr "genDerivStuff: bad derived class" <+> ppr clas )
-          mapM (tcATDefault False loc mini_subst emptyNameSet)
+          mapM (tcATDefault loc mini_subst emptyNameSet)
                (classATItems clas)
         return ( emptyBag -- No method bindings are needed...
                , listToBag (map DerivFamInst (concat tyfam_insts))
@@ -1755,8 +1757,8 @@ is used:
 In the latter case, we must take care to check if C has any associated type
 families with default instances, because -XDeriveAnyClass will never provide
 an implementation for them. We "fill in" the default instances using the
-tcATDefault function from TcClsDcl (which is also used in TcInstDcls to handle
-the empty instance declaration case).
+tcATDefault function from TcClassDcl (which is also used in TcInstDcls to
+handle the empty instance declaration case).
 
 Note [Deriving strategies]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/typecheck/TcDerivInfer.hs b/compiler/typecheck/TcDerivInfer.hs
index 02c0103eec..7d39c31b7b 100644
--- a/compiler/typecheck/TcDerivInfer.hs
+++ b/compiler/typecheck/TcDerivInfer.hs
@@ -67,10 +67,43 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TcType
 inferConstraints tvs main_cls cls_tys inst_ty
                  rep_tc rep_tc_args
                  mechanism
-  | is_generic && not is_anyclass          -- Generic constraints are easy
+  = do { (inferred_constraints, tvs', inst_tys') <- infer_constraints
+       ; traceTc "inferConstraints" $ vcat
+              [ ppr main_cls <+> ppr inst_tys'
+              , ppr inferred_constraints
+              ]
+       ; return ( sc_constraints ++ inferred_constraints
+                , tvs', inst_tys' ) }
+  where
+    is_anyclass = isDerivSpecAnyClass mechanism
+    infer_constraints
+      | is_anyclass = inferConstraintsDAC tvs main_cls inst_tys
+      | otherwise   = inferConstraintsDataConArgs tvs main_cls cls_tys inst_ty
+                                                  rep_tc rep_tc_args
+
+    inst_tys = cls_tys ++ [inst_ty]
+
+        -- Constraints arising from superclasses
+        -- See Note [Superclasses of derived instance]
+    cls_tvs  = classTyVars main_cls
+    sc_constraints = ASSERT2( equalLength cls_tvs inst_tys
+                            , ppr main_cls <+> ppr inst_tys )
+                     [ mkThetaOrigin DerivOrigin TypeLevel [] [] $
+                       substTheta cls_subst (classSCTheta main_cls) ]
+    cls_subst = ASSERT( equalLength cls_tvs inst_tys )
+                zipTvSubst cls_tvs inst_tys
+
+-- | Like 'inferConstraints', but used only in the case of deriving strategies
+-- where the constraints are inferred by inspecting the fields of each data
+-- constructor (i.e., stock- and newtype-deriving).
+inferConstraintsDataConArgs
+  :: [TyVar] -> Class -> [TcType] -> TcType -> TyCon -> [TcType]
+  -> TcM ([ThetaOrigin], [TyVar], [TcType])
+inferConstraintsDataConArgs tvs main_cls cls_tys inst_ty rep_tc rep_tc_args
+  | is_generic                             -- Generic constraints are easy
   = return ([], tvs, inst_tys)
 
-  | is_generic1 && not is_anyclass         -- Generic1 needs Functor
+  | is_generic1                            -- Generic1 needs Functor
   = ASSERT( rep_tc_tvs `lengthExceeds` 0 ) -- See Note [Getting base classes]
     ASSERT( cls_tys `lengthIs` 1 )         -- Generic1 has a single kind variable
     do { functorClass <- tcLookupClass functorClassName
@@ -82,20 +115,15 @@ inferConstraints tvs main_cls cls_tys inst_ty
     ASSERT2( equalLength rep_tc_tvs all_rep_tc_args
            , ppr main_cls <+> ppr rep_tc
              $$ ppr rep_tc_tvs $$ ppr all_rep_tc_args )
-      do { (arg_constraints, tvs', inst_tys') <- infer_constraints
-         ; traceTc "inferConstraints" $ vcat
+      do { (arg_constraints, tvs', inst_tys')
+             <- con_arg_constraints get_std_constrained_tys
+         ; traceTc "inferConstraintsDataConArgs" $ vcat
                 [ ppr main_cls <+> ppr inst_tys'
                 , ppr arg_constraints
                 ]
-         ; return (stupid_constraints ++ extra_constraints
-                    ++ sc_constraints ++ arg_constraints
+         ; return ( stupid_constraints ++ extra_constraints ++ arg_constraints
                   , tvs', inst_tys') }
   where
-    is_anyclass = isDerivSpecAnyClass mechanism
-    infer_constraints
-      | is_anyclass = inferConstraintsDAC main_cls tvs inst_tys
-      | otherwise   = con_arg_constraints get_std_constrained_tys
-
     tc_binders = tyConBinders rep_tc
     choose_level bndr
       | isNamedTyConBinder bndr = KindLevel
@@ -187,15 +215,7 @@ inferConstraints tvs main_cls cls_tys inst_ty
     all_rep_tc_args = rep_tc_args ++ map mkTyVarTy
                                      (drop (length rep_tc_args) rep_tc_tvs)
 
-        -- Constraints arising from superclasses
-        -- See Note [Superclasses of derived instance]
-    cls_tvs  = classTyVars main_cls
     inst_tys = cls_tys ++ [inst_ty]
-    sc_constraints = ASSERT2( equalLength cls_tvs inst_tys, ppr main_cls <+> ppr rep_tc)
-                     [ mkThetaOrigin DerivOrigin TypeLevel [] [] $
-                       substTheta cls_subst (classSCTheta main_cls) ]
-    cls_subst = ASSERT( equalLength cls_tvs inst_tys )
-                zipTvSubst cls_tvs inst_tys
 
         -- Stupid constraints
     stupid_constraints = [ mkThetaOrigin DerivOrigin TypeLevel [] [] $
@@ -240,9 +260,9 @@ typeToTypeKind = liftedTypeKind `mkFunTy` liftedTypeKind
 -- See Note [Gathering and simplifying constraints for DeriveAnyClass]
 -- for an explanation of how these constraints are used to determine the
 -- derived instance context.
-inferConstraintsDAC :: Class -> [TyVar] -> [TcType]
+inferConstraintsDAC :: [TyVar] -> Class -> [TcType]
                     -> TcM ([ThetaOrigin], [TyVar], [TcType])
-inferConstraintsDAC cls tvs inst_tys
+inferConstraintsDAC tvs cls inst_tys
   = do { let gen_dms = [ (sel_id, dm_ty)
                        | (sel_id, Just (_, GenericDM dm_ty)) <- classOpItems cls ]
 
@@ -760,7 +780,7 @@ Similarly for 'baz', givng the constraint C2
                                 ~ Maybe s -> Maybe s -> Bool)
 
 In this case baz has no local quantification, so the implication
-constraint has no local skolems and there are no unificaiton
+constraint has no local skolems and there are no unification
 variables.
 
 [STEP DAC SOLVE]
diff --git a/compiler/typecheck/TcDerivUtils.hs b/compiler/typecheck/TcDerivUtils.hs
index 09876afb70..05d323c8ff 100644
--- a/compiler/typecheck/TcDerivUtils.hs
+++ b/compiler/typecheck/TcDerivUtils.hs
@@ -6,7 +6,6 @@
 Error-checking and other utilities for @deriving@ clauses or declarations.
 -}
 
-{-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module TcDerivUtils (
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 016b98521d..925e58068e 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -53,17 +53,17 @@ import SrcLoc
 import DynFlags
 import ListSetOps       ( equivClasses )
 import Maybes
+import Pair
 import qualified GHC.LanguageExtensions as LangExt
 import FV ( fvVarList, unionFV )
 
 import Control.Monad    ( when )
+import Data.Foldable    ( toList )
 import Data.List        ( partition, mapAccumL, nub, sortBy, unfoldr )
 import qualified Data.Set as Set
 
-#if __GLASGOW_HASKELL__ > 710
 import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
-#endif
 
 
 {-
@@ -246,10 +246,8 @@ Unfortunately, unlike the context, the relevant bindings are added in
 multiple places so they have to be in the Report.
 -}
 
-#if __GLASGOW_HASKELL__ > 710
 instance Semigroup Report where
     Report a1 b1 c1 <> Report a2 b2 c2 = Report (a1 ++ a2) (b1 ++ b2) (c1 ++ c2)
-#endif
 
 instance Monoid Report where
     mempty = Report [] [] []
@@ -478,19 +476,22 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_insol = insols, wc_impl
     -- (see TcRnTypes.trulyInsoluble) is caught here, otherwise
     -- we might suppress its error message, and proceed on past
     -- type checking to get a Lint error later
-    report1 = [ ("custom_error", is_user_type_error,
-                                                  True, mkUserTypeErrorReporter)
+    report1 = [ ("custom_error", is_user_type_error,True, mkUserTypeErrorReporter)
               , given_eq_spec
-              , ("insoluble2",   utterly_wrong,   True, mkGroupReporter mkEqErr)
-              , ("skolem eq1",   very_wrong,      True, mkSkolReporter)
-              , ("skolem eq2",   skolem_eq,       True, mkSkolReporter)
-              , ("non-tv eq",    non_tv_eq,       True, mkSkolReporter)
-              , ("Out of scope", is_out_of_scope, True, mkHoleReporter)
-              , ("Holes",        is_hole,         False, mkHoleReporter)
+              , ("insoluble2",    utterly_wrong,    True, mkGroupReporter mkEqErr)
+              , ("skolem eq1",    very_wrong,       True, mkSkolReporter)
+              , ("skolem eq2",    skolem_eq,        True, mkSkolReporter)
+              , ("non-tv eq",     non_tv_eq,        True, mkSkolReporter)
+              , ("Out of scope",  is_out_of_scope,  True, mkHoleReporter)
+              , ("Holes",         is_hole,          False, mkHoleReporter)
 
                   -- The only remaining equalities are alpha ~ ty,
                   -- where alpha is untouchable; and representational equalities
-              , ("Other eqs",    is_equality,     False, mkGroupReporter mkEqErr) ]
+                  -- Prefer homogeneous equalities over hetero, because the
+                  -- former might be holding up the latter.
+                  -- See Note [Equalities with incompatible kinds] in TcCanonical
+              , ("Homo eqs",      is_homo_equality, True,  mkGroupReporter mkEqErr)
+              , ("Other eqs",     is_equality,      False, mkGroupReporter mkEqErr) ]
 
     -- report2: we suppress these if there are insolubles elsewhere in the tree
     report2 = [ ("Implicit params", is_ip,           False, mkGroupReporter mkIPErr)
@@ -527,6 +528,9 @@ reportWanteds ctxt tc_lvl (WC { wc_simple = simples, wc_insol = insols, wc_impl
 
     is_user_type_error ct _ = isUserTypeErrorCt ct
 
+    is_homo_equality _ (EqPred _ ty1 ty2) = typeKind ty1 `tcEqType` typeKind ty2
+    is_homo_equality _ _                  = False
+
     is_equality _ (EqPred {}) = True
     is_equality _ _           = False
 
@@ -694,7 +698,7 @@ mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM ErrMsg)
 -- Group together errors from same location,
 -- and report only the first (to avoid a cascade)
 mkGroupReporter mk_err ctxt cts
-  = mapM_ (reportGroup mk_err ctxt) (equivClasses cmp_loc cts)
+  = mapM_ (reportGroup mk_err ctxt . toList) (equivClasses cmp_loc cts)
 
 eq_lhs_type :: Ct -> Ct -> Bool
 eq_lhs_type ct1 ct2
@@ -815,17 +819,21 @@ maybeAddDeferredHoleBinding ctxt err ct
 tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
 -- Use the first reporter in the list whose predicate says True
 tryReporters ctxt reporters cts
-  = do { traceTc "tryReporters {" (ppr cts)
-       ; (ctxt', cts') <- go ctxt reporters cts
+  = do { let (vis_cts, invis_cts) = partition (isVisibleOrigin . ctOrigin) cts
+       ; traceTc "tryReporters {" (ppr vis_cts $$ ppr invis_cts)
+       ; (ctxt', cts') <- go ctxt reporters vis_cts invis_cts
        ; traceTc "tryReporters }" (ppr cts')
        ; return (ctxt', cts') }
   where
-    go ctxt [] cts
-      = return (ctxt, cts)
-
-    go ctxt (r : rs) cts
-      = do { (ctxt', cts') <- tryReporter ctxt r cts
-           ; go ctxt' rs cts' }
+    go ctxt [] vis_cts invis_cts
+      = return (ctxt, vis_cts ++ invis_cts)
+
+    go ctxt (r : rs) vis_cts invis_cts
+       -- always look at *visible* Origins before invisible ones
+       -- this is the whole point of isVisibleOrigin
+      = do { (ctxt', vis_cts') <- tryReporter ctxt r vis_cts
+           ; (ctxt'', invis_cts') <- tryReporter ctxt' r invis_cts
+           ; go ctxt'' rs vis_cts' invis_cts' }
                 -- Carry on with the rest, because we must make
                 -- deferred bindings for them if we have -fdefer-type-errors
                 -- But suppress their error messages
@@ -1447,9 +1455,9 @@ the unsolved (t ~ Bool), t won't look like an untouchable meta-var
 any more.  So we don't assert that it is.
 -}
 
-mkEqErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
 -- Don't have multiple equality errors from the same location
 -- E.g.   (Int,Bool) ~ (Bool,Int)   one error will do!
+mkEqErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg
 mkEqErr ctxt (ct:_) = mkEqErr1 ctxt ct
 mkEqErr _ [] = panic "mkEqErr"
 
@@ -1589,9 +1597,12 @@ mkEqErr_help :: DynFlags -> ReportErrCtxt -> Report
              -> Maybe SwapFlag   -- Nothing <=> not sure
              -> TcType -> TcType -> TcM ErrMsg
 mkEqErr_help dflags ctxt report ct oriented ty1 ty2
-  | Just tv1 <- tcGetTyVar_maybe ty1 = mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2
-  | Just tv2 <- tcGetTyVar_maybe ty2 = mkTyVarEqErr dflags ctxt report ct swapped  tv2 ty1
-  | otherwise                        = reportEqErr ctxt report ct oriented ty1 ty2
+  | Just (tv1, co1) <- tcGetCastedTyVar_maybe ty1
+  = mkTyVarEqErr dflags ctxt report ct oriented tv1 co1 ty2
+  | Just (tv2, co2) <- tcGetCastedTyVar_maybe ty2
+  = mkTyVarEqErr dflags ctxt report ct swapped  tv2 co2 ty1
+  | otherwise
+  = reportEqErr ctxt report ct oriented ty1 ty2
   where
     swapped = fmap flipSwap oriented
 
@@ -1606,13 +1617,13 @@ reportEqErr ctxt report ct oriented ty1 ty2
 
 mkTyVarEqErr, mkTyVarEqErr'
   :: DynFlags -> ReportErrCtxt -> Report -> Ct
-             -> Maybe SwapFlag -> TcTyVar -> TcType -> TcM ErrMsg
+             -> Maybe SwapFlag -> TcTyVar -> TcCoercionN -> TcType -> TcM ErrMsg
 -- tv1 and ty2 are already tidied
-mkTyVarEqErr dflags ctxt report ct oriented tv1 ty2
-  = do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr ty2)
-       ; mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2 }
+mkTyVarEqErr dflags ctxt report ct oriented tv1 co1 ty2
+  = do { traceTc "mkTyVarEqErr" (ppr ct $$ ppr tv1 $$ ppr co1 $$ ppr ty2)
+       ; mkTyVarEqErr' dflags ctxt report ct oriented tv1 co1 ty2 }
 
-mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
+mkTyVarEqErr' dflags ctxt report ct oriented tv1 co1 ty2
   | not insoluble_occurs_check   -- See Note [Occurs check wins]
   , isUserSkolem ctxt tv1   -- ty2 won't be a meta-tyvar, or else the thing would
                             -- be oriented the other way round;
@@ -1661,6 +1672,23 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
        -- to be helpful since this is just an unimplemented feature.
        ; mkErrorMsgFromCt ctxt ct $ report { report_important = [msg] } }
 
+   -- check for heterogeneous equality next; see Note [Equalities with incompatible kinds]
+   -- in TcCanonical
+  | not (k1 `tcEqType` k2)
+  = do { let main_msg = addArising (ctOrigin ct) $
+                        vcat [ hang (text "Kind mismatch: cannot unify" <+>
+                                     parens (ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1)) <+>
+                                     text "with:")
+                                  2 (sep [ppr ty2, dcolon, ppr k2])
+                             , text "Their kinds differ." ]
+             cast_msg
+               | isTcReflexiveCo co1 = empty
+               | otherwise           = text "NB:" <+> ppr tv1 <+>
+                                       text "was casted to have kind" <+>
+                                       quotes (ppr k1)
+
+       ; mkErrorMsgFromCt ctxt ct (mconcat [important main_msg, important cast_msg, report]) }
+
   -- If the immediately-enclosing implication has 'tv' a skolem, and
   -- we know by now its an InferSkol kind of skolem, then presumably
   -- it started life as a SigTv, else it'd have been unified, given
@@ -1706,7 +1734,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
   , Implic { ic_env = env, ic_given = given
            , ic_tclvl = lvl, ic_info = skol_info } <- implic
   = ASSERT2( not (isTouchableMetaTyVar lvl tv1)
-           , ppr tv1 )  -- See Note [Error messages for untouchables]
+           , ppr tv1 $$ ppr lvl )  -- See Note [Error messages for untouchables]
     do { let msg = important $ misMatchMsg ct oriented ty1 ty2
              tclvl_extra = important $
                   nest 2 $
@@ -1725,6 +1753,9 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 ty2
         -- Consider an ambiguous top-level constraint (a ~ F a)
         -- Not an occurs check, because F is a type function.
   where
+    Pair _ k1 = tcCoercionKind co1
+    k2        = typeKind ty2
+
     ty1 = mkTyVarTy tv1
     occ_check_expand       = occCheckForErrors dflags tv1 ty2
     insoluble_occurs_check = isInsolubleOccursCheck (ctEqRel ct) tv1 ty2
@@ -1962,7 +1993,7 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act
         -> empty
 
     thing_msg = case maybe_thing of
-                  Just thing -> \_ -> quotes (ppr thing) <+> text "is"
+                  Just thing -> \_ -> quotes thing <+> text "is"
                   Nothing    -> \vowel -> text "got a" <>
                                           if vowel then char 'n' else empty
     msg2 = sep [ text "Expecting a lifted type, but"
@@ -1972,12 +2003,12 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act
     msg4 = maybe_num_args_msg $$
            sep [ text "Expected a type, but"
                , maybe (text "found something with kind")
-                       (\thing -> quotes (ppr thing) <+> text "has kind")
+                       (\thing -> quotes thing <+> text "has kind")
                        maybe_thing
                , quotes (ppr act) ]
 
     msg5 th = hang (text "Expected" <+> kind_desc <> comma)
-                 2 (text "but" <+> quotes (ppr th) <+> text "has kind" <+>
+                 2 (text "but" <+> quotes th <+> text "has kind" <+>
                     quotes (ppr act))
       where
         kind_desc | isConstraintKind exp = text "a constraint"
@@ -1989,17 +2020,13 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act
         -> let n_act = count_args act
                n_exp = count_args exp in
            case n_act - n_exp of
-             n | n /= 0
+             n | n > 0   -- we don't know how many args there are, so don't
+                         -- recommend removing args that aren't
                , Just thing <- maybe_thing
-               , case errorThingNumArgs_maybe thing of
-                   Nothing           -> n > 0
-                   Just num_act_args -> num_act_args >= -n
-                     -- don't report to strip off args that aren't there
                -> Just $ text "Expecting" <+> speakN (abs n) <+>
-                         more_or_fewer <+> quotes (ppr thing)
+                         more <+> quotes thing
                where
-                 more_or_fewer
-                  | n < 0     = text "fewer arguments to"
+                 more
                   | n == 1    = text "more argument to"
                   | otherwise = text "more arguments to"  -- n > 1
              _ -> Nothing
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index eb809ab013..4f305c6920 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -33,7 +33,7 @@ module TcEvidence (
   mkTcKindCo,
   tcCoercionKind, coVarsOfTcCo,
   mkTcCoVarCo,
-  isTcReflCo,
+  isTcReflCo, isTcReflexiveCo,
   tcCoercionRole,
   unwrapIP, wrapIP
   ) where
@@ -115,6 +115,10 @@ tcCoercionRole         :: TcCoercion -> Role
 coVarsOfTcCo           :: TcCoercion -> TcTyCoVarSet
 isTcReflCo             :: TcCoercion -> Bool
 
+-- | This version does a slow check, calculating the related types and seeing
+-- if they are equal.
+isTcReflexiveCo        :: TcCoercion -> Bool
+
 mkTcReflCo             = mkReflCo
 mkTcSymCo              = mkSymCo
 mkTcTransCo            = mkTransCo
@@ -143,7 +147,7 @@ tcCoercionKind         = coercionKind
 tcCoercionRole         = coercionRole
 coVarsOfTcCo           = coVarsOfCo
 isTcReflCo             = isReflCo
-
+isTcReflexiveCo        = isReflexiveCo
 
 {-
 %************************************************************************
diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs
index 0e1e8662bf..195ba0139e 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -166,8 +166,8 @@ NB: The res_ty is always deeply skolemised.
 -}
 
 tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
-tcExpr (HsVar (L _ name)) res_ty = tcCheckId name res_ty
-tcExpr (HsUnboundVar uv)  res_ty = tcUnboundId uv res_ty
+tcExpr (HsVar (L _ name))   res_ty = tcCheckId name res_ty
+tcExpr e@(HsUnboundVar uv)  res_ty = tcUnboundId e uv res_ty
 
 tcExpr e@(HsApp {})     res_ty = tcApp1 e res_ty
 tcExpr e@(HsAppType {}) res_ty = tcApp1 e res_ty
@@ -370,7 +370,7 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
        ; let doc   = text "The first argument of ($) takes"
              orig1 = lexprCtOrigin arg1
        ; (wrap_arg1, [arg2_sigma], op_res_ty) <-
-           matchActualFunTys doc orig1 (Just arg1) 1 arg1_ty
+           matchActualFunTys doc orig1 (Just (unLoc arg1)) 1 arg1_ty
 
          -- We have (arg1 $ arg2)
          -- So: arg1_ty = arg2_ty -> op_res_ty
@@ -385,7 +385,7 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
        --
        -- The *result* type can have any kind (Trac #8739),
        -- so we don't need to check anything for that
-       ; _ <- unifyKind (Just arg2_sigma) (typeKind arg2_sigma) liftedTypeKind
+       ; _ <- unifyKind (Just (HsCoreTy arg2_sigma)) (typeKind arg2_sigma) liftedTypeKind
            -- ignore the evidence. arg2_sigma must have type * or #,
            -- because we know arg2_sigma -> or_res_ty is well-kinded
            -- (because otherwise matchActualFunTys would fail)
@@ -434,7 +434,7 @@ tcExpr expr@(OpApp arg1 op fix arg2) res_ty
 tcExpr expr@(SectionR op arg2) res_ty
   = do { (op', op_ty) <- tcInferFun op
        ; (wrap_fun, [arg1_ty, arg2_ty], op_res_ty)
-                  <- matchActualFunTys (mk_op_msg op) fn_orig (Just op) 2 op_ty
+                  <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op)) 2 op_ty
        ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)
                                  (mkFunTy arg1_ty op_res_ty) res_ty
        ; arg2' <- tcArg op arg2 arg2_ty 2
@@ -453,7 +453,7 @@ tcExpr expr@(SectionL arg1 op) res_ty
                          | otherwise                            = 2
 
        ; (wrap_fn, (arg1_ty:arg_tys), op_res_ty)
-           <- matchActualFunTys (mk_op_msg op) fn_orig (Just op)
+           <- matchActualFunTys (mk_op_msg op) fn_orig (Just (unLoc op))
                                 n_reqd_args op_ty
        ; wrap_res <- tcSubTypeHR SectionOrigin (Just expr)
                                  (mkFunTys arg_tys op_res_ty) res_ty
@@ -938,7 +938,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
 
         ; wrap_res <- tcSubTypeHR (exprCtOrigin expr)
                                   (Just expr) rec_res_ty res_ty
-        ; co_scrut <- unifyType (Just record_expr) record_rho scrut_ty
+        ; co_scrut <- unifyType (Just (unLoc record_expr)) record_rho scrut_ty
                 -- NB: normal unification is OK here (as opposed to subsumption),
                 -- because for this to work out, both record_rho and scrut_ty have
                 -- to be normal datatypes -- no contravariant stuff can go on
@@ -974,8 +974,8 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr, rupd_flds = rbnds }) res_ty
                     , rupd_cons = relevant_cons, rupd_in_tys = scrut_inst_tys
                     , rupd_out_tys = result_inst_tys, rupd_wrap = req_wrap } }
 
-tcExpr (HsRecFld f) res_ty
-    = tcCheckRecSelId f res_ty
+tcExpr e@(HsRecFld f) res_ty
+    = tcCheckRecSelId e f res_ty
 
 {-
 ************************************************************************
@@ -1037,10 +1037,10 @@ tcExpr (HsSpliceE (HsSpliced mod_finalizers (HsSplicedExpr expr)))
        tcExpr expr res_ty
 tcExpr (HsSpliceE splice)        res_ty
   = tcSpliceExpr splice res_ty
-tcExpr (HsBracket brack)         res_ty
-  = tcTypedBracket   brack res_ty
-tcExpr (HsRnBracketOut brack ps) res_ty
-  = tcUntypedBracket brack ps res_ty
+tcExpr e@(HsBracket brack)         res_ty
+  = tcTypedBracket e brack res_ty
+tcExpr e@(HsRnBracketOut brack ps) res_ty
+  = tcUntypedBracket e brack ps res_ty
 
 {-
 ************************************************************************
@@ -1194,7 +1194,7 @@ tcApp m_herald orig_fun orig_args res_ty
                 -- up to call that function
            ; wrap_res <- addFunResCtxt True (unLoc fun) actual_res_ty res_ty $
                          tcSubTypeDS_NC_O orig GenSigCtxt
-                           (Just $ foldl mk_hs_app fun args)
+                           (Just $ unLoc $ foldl mk_hs_app fun args)
                            actual_res_ty res_ty
 
            ; return (wrap_res, mkLHsWrap wrap_fun fun1, args1) }
@@ -1290,7 +1290,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
 
     go acc_args n fun_ty (Left arg : args)
       = do { (wrap, [arg_ty], res_ty)
-               <- matchActualFunTysPart herald fun_orig (Just fun) 1 fun_ty
+               <- matchActualFunTysPart herald fun_orig (Just (unLoc fun)) 1 fun_ty
                                         acc_args orig_arity
                -- wrap :: fun_ty "->" arg_ty -> res_ty
            ; arg' <- tcArg fun arg arg_ty n
@@ -1449,7 +1449,7 @@ tcSynArgA :: CtOrigin
             -- and a wrapper to be applied to the overall expression
 tcSynArgA orig sigma_ty arg_shapes res_shape thing_inside
   = do { (match_wrapper, arg_tys, res_ty)
-           <- matchActualFunTys herald orig noThing (length arg_shapes) sigma_ty
+           <- matchActualFunTys herald orig Nothing (length arg_shapes) sigma_ty
               -- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty)
        ; ((result, res_wrapper), arg_wrappers)
            <- tc_syn_args_e arg_tys arg_shapes $ \ arg_results ->
@@ -1561,7 +1561,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
                         = ApplyMR
                         | otherwise
                         = NoRestrictions
-       ; (qtvs, givens, ev_binds)
+       ; (qtvs, givens, ev_binds, _)
                  <- simplifyInfer tclvl infer_mode [sig_inst] [(name, tau)] wanted
        ; tau <- zonkTcType tau
        ; let inferred_theta = map evVarPred givens
@@ -1623,18 +1623,18 @@ tcCheckId name res_ty
   = do { (expr, actual_res_ty) <- tcInferId name
        ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty])
        ; addFunResCtxt False (HsVar (noLoc name)) actual_res_ty res_ty $
-         tcWrapResultO (OccurrenceOf name)  expr actual_res_ty res_ty }
+         tcWrapResultO (OccurrenceOf name) (HsVar (noLoc name)) expr actual_res_ty res_ty }
 
-tcCheckRecSelId :: AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
-tcCheckRecSelId f@(Unambiguous (L _ lbl) _) res_ty
+tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcCheckRecSelId rn_expr f@(Unambiguous (L _ lbl) _) res_ty
   = do { (expr, actual_res_ty) <- tcInferRecSelId f
        ; addFunResCtxt False (HsRecFld f) actual_res_ty res_ty $
-         tcWrapResultO (OccurrenceOfRecSel lbl) expr actual_res_ty res_ty }
-tcCheckRecSelId (Ambiguous lbl _) res_ty
+         tcWrapResultO (OccurrenceOfRecSel lbl) rn_expr expr actual_res_ty res_ty }
+tcCheckRecSelId rn_expr (Ambiguous lbl _) res_ty
   = case tcSplitFunTy_maybe =<< checkingExpType_maybe res_ty of
       Nothing       -> ambiguousSelector lbl
       Just (arg, _) -> do { sel_name <- disambiguateSelector lbl arg
-                          ; tcCheckRecSelId (Unambiguous lbl sel_name) res_ty }
+                          ; tcCheckRecSelId rn_expr (Unambiguous lbl sel_name) res_ty }
 
 ------------------------
 tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTcId, TcRhoType)
@@ -1724,7 +1724,7 @@ tc_infer_id lbl id_name
       | otherwise                  = return ()
 
 
-tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcUnboundId :: HsExpr GhcRn -> UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)
 -- Typecheck an occurrence of an unbound Id
 --
 -- Some of these started life as a true expression hole "_".
@@ -1733,7 +1733,7 @@ tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)
 -- We turn all of them into HsVar, since HsUnboundVar can't contain an
 -- Id; and indeed the evidence for the CHoleCan does bind it, so it's
 -- not unbound any more!
-tcUnboundId unbound res_ty
+tcUnboundId rn_expr unbound res_ty
  = do { ty <- newOpenFlexiTyVarTy  -- Allow Int# etc (Trac #12531)
       ; let occ = unboundVarOcc unbound
       ; name <- newSysName occ
@@ -1745,7 +1745,7 @@ tcUnboundId unbound res_ty
                                               , ctev_loc  = loc}
                            , cc_hole = ExprHole unbound }
       ; emitInsoluble can
-      ; tcWrapResultO (UnboundOccurrenceOf occ) (HsVar (noLoc ev)) ty res_ty }
+      ; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr (HsVar (noLoc ev)) ty res_ty }
 
 
 {-
diff --git a/compiler/typecheck/TcFlatten.hs b/compiler/typecheck/TcFlatten.hs
index 1bb4a7165b..69f8357a1d 100644
--- a/compiler/typecheck/TcFlatten.hs
+++ b/compiler/typecheck/TcFlatten.hs
@@ -584,7 +584,7 @@ setMode new_mode thing_inside
     else runFlatM thing_inside (env { fe_mode = new_mode })
 
 -- | Use when flattening kinds/kind coercions. See
--- Note [No derived kind equalities] in TcCanonical
+-- Note [No derived kind equalities]
 flattenKinds :: FlatM a -> FlatM a
 flattenKinds thing_inside
   = FlatM $ \env ->
@@ -717,6 +717,18 @@ soon throw out the phantoms when decomposing a TyConApp. (Or, the
 canonicaliser will emit an insoluble, in which case the unflattened version
 yields a better error message anyway.)
 
+Note [No derived kind equalities]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We call flattenKinds in two places: in flatten_co (Note [Flattening coercions])
+and in flattenTyVar. The latter case is easier to understand; flattenKinds is
+used to flatten the kind of a flat (i.e. inert) tyvar. Flattening a kind
+naturally produces a coercion. This coercion is then used in the flattened type.
+However, danger lurks if the flattening flavour (that is, the fe_flavour of the
+FlattenEnv) is Derived: the coercion might be bottom. (This can happen when
+looks up a kindvar in the inert set only to find a Derived equality, with
+no coercion.) The solution is simple: ensure that the fe_flavour is not derived
+when flattening a kind. This is what flattenKinds does.
+
 -}
 
 {- *********************************************************************
@@ -1326,10 +1338,9 @@ flattenTyVar tv
 
            FTRNotFollowed   -- Done
              -> do { let orig_kind = tyVarKind tv
-                   ; (_new_kind, kind_co) <- setMode FM_SubstOnly $
-                                             flattenKinds $
+                   ; (_new_kind, kind_co) <- flattenKinds $
                                              flatten_one orig_kind
-                     ; let Pair _ zonked_kind = coercionKind kind_co
+                   ; let Pair _ zonked_kind = coercionKind kind_co
              -- NB: kind_co :: _new_kind ~ zonked_kind
              -- But zonked_kind is not necessarily the same as orig_kind
              -- because that may have filled-in metavars.
@@ -1339,13 +1350,13 @@ flattenTyVar tv
              -- See also Note [Flattening]
              -- An alternative would to use (zonkTcType orig_kind),
              -- but some simple measurements suggest that's a little slower
-                    ; let tv'    = setTyVarKind tv zonked_kind
-                          tv_ty' = mkTyVarTy tv'
-                          ty'    = tv_ty' `mkCastTy` mkSymCo kind_co
+                   ; let tv'    = setTyVarKind tv zonked_kind
+                         tv_ty' = mkTyVarTy tv'
+                         ty'    = tv_ty' `mkCastTy` mkSymCo kind_co
 
-                    ; role <- getRole
-                    ; return (ty', mkReflCo role tv_ty'
-                                   `mkCoherenceLeftCo` mkSymCo kind_co) } }
+                   ; role <- getRole
+                   ; return (ty', mkReflCo role tv_ty'
+                                  `mkCoherenceLeftCo` mkSymCo kind_co) } }
 
 flatten_tyvar1 :: TcTyVar -> FlatM FlattenTvResult
 -- "Flattening" a type variable means to apply the substitution to it
diff --git a/compiler/typecheck/TcGenDeriv.hs b/compiler/typecheck/TcGenDeriv.hs
index 7e79c12ed6..00ed9edc11 100644
--- a/compiler/typecheck/TcGenDeriv.hs
+++ b/compiler/typecheck/TcGenDeriv.hs
@@ -1679,7 +1679,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
                                     fam_tc rep_lhs_tys rep_rhs_ty
         -- Check (c) from Note [GND and associated type families] in TcDeriv
         checkValidTyFamEqn (Just (cls, cls_tvs, lhs_env)) fam_tc rep_tvs'
-                           rep_cvs' rep_lhs_tys rep_rhs_ty loc
+                           rep_cvs' rep_lhs_tys rep_rhs_ty pp_lhs loc
         newFamInst SynFamilyInst axiom
       where
         cls_tvs     = classTyVars cls
@@ -1696,6 +1696,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty
         (rep_tvs, rep_cvs) = partition isTyVar rep_tcvs
         rep_tvs'    = toposortTyVars rep_tvs
         rep_cvs'    = toposortTyVars rep_cvs
+        pp_lhs      = ppr (mkTyConApp fam_tc rep_lhs_tys)
 
 nlHsAppType :: LHsExpr GhcPs -> Type -> LHsExpr GhcPs
 nlHsAppType e s = noLoc (e `HsAppType` hs_ty)
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 93ed47040c..0713fabd18 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -34,7 +34,7 @@ module TcHsSyn (
         emptyZonkEnv, mkEmptyZonkEnv,
         zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
         zonkCoToCo, zonkSigType,
-        zonkEvBinds,
+        zonkEvBinds, zonkTcEvBinds
   ) where
 
 #include "HsVersions.h"
@@ -455,24 +455,44 @@ zonk_bind env bind@(FunBind { fun_id = L loc var, fun_matches = ms
 zonk_bind env (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = evs
                         , abs_ev_binds = ev_binds
                         , abs_exports = exports
-                        , abs_binds = val_binds })
+                        , abs_binds = val_binds
+                        , abs_sig = has_sig })
   = ASSERT( all isImmutableTyVar tyvars )
     do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars
        ; (env1, new_evs) <- zonkEvBndrsX env0 evs
        ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds
        ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) ->
-         do { let env3 = extendIdZonkEnvRec env2
-                           (collectHsBindsBinders new_val_binds)
-            ; new_val_binds <- zonkMonoBinds env3 val_binds
-            ; new_exports   <- mapM (zonkExport env3) exports
+         do { let env3 = extendIdZonkEnvRec env2 $
+                         collectHsBindsBinders new_val_binds
+            ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds
+            ; new_exports   <- mapM (zonk_export env3) exports
             ; return (new_val_binds, new_exports) }
        ; return (AbsBinds { abs_tvsa = new_tyvars, abs_ev_varsa = new_evs
                           , abs_ev_binds = new_ev_binds
-                          , abs_exports = new_exports, abs_binds = new_val_bind }) }
+                          , abs_exports = new_exports, abs_binds = new_val_bind
+                          , abs_sig = has_sig }) }
   where
-    zonkExport env (ABE{ abe_wrap = wrap
-                       , abe_poly = poly_id
-                       , abe_mono = mono_id, abe_prags = prags })
+    zonk_val_bind env lbind
+      | has_sig
+      , L loc bind@(FunBind { fun_id      = L mloc mono_id
+                            , fun_matches = ms
+                            , fun_co_fn   = co_fn }) <- lbind
+      = do { new_mono_id <- updateVarTypeM (zonkTcTypeToType env) mono_id
+                            -- Specifically /not/ zonkIdBndr; we do not
+                            -- want to complain about a levity-polymorphic binder
+           ; (env', new_co_fn) <- zonkCoFn env co_fn
+           ; new_ms            <- zonkMatchGroup env' zonkLExpr ms
+           ; return $ L loc $
+             bind { fun_id      = L mloc new_mono_id
+                  , fun_matches = new_ms
+                  , fun_co_fn   = new_co_fn } }
+      | otherwise
+      = zonk_lbind env lbind   -- The normal case
+
+    zonk_export env (ABE{ abe_wrap = wrap
+                        , abe_poly = poly_id
+                        , abe_mono = mono_id
+                        , abe_prags = prags })
         = do new_poly_id <- zonkIdBndr env poly_id
              (_, new_wrap) <- zonkCoFn env wrap
              new_prags <- zonkSpecPrags env prags
@@ -481,44 +501,6 @@ zonk_bind env (AbsBinds { abs_tvsa = tyvars, abs_ev_varsa = evs
                         , abe_mono = zonkIdOcc env mono_id
                         , abe_prags = new_prags })
 
-zonk_bind env outer_bind@(AbsBindsSig { abs_tvs         = tyvars
-                                      , abs_ev_vars     = evs
-                                      , abs_sig_export  = poly
-                                      , abs_sig_prags   = prags
-                                      , abs_sig_ev_bind = ev_bind
-                                      , abs_sig_bind    = lbind })
-  | L bind_loc bind@(FunBind { fun_id      = L loc local
-                             , fun_matches = ms
-                             , fun_co_fn   = co_fn }) <- lbind
-  = ASSERT( all isImmutableTyVar tyvars )
-    do { (env0, new_tyvars)  <- zonkTyBndrsX env  tyvars
-       ; (env1, new_evs)     <- zonkEvBndrsX env0 evs
-       ; (env2, new_ev_bind) <- zonkTcEvBinds env1 ev_bind
-           -- Inline zonk_bind (FunBind ...) because we wish to skip
-           -- the check for representation-polymorphic binders. The
-           -- local binder in the FunBind in an AbsBindsSig is never actually
-           -- bound in Core -- indeed, that's the whole point of AbsBindsSig.
-           -- just calling zonk_bind causes #11405.
-       ; new_local           <- updateVarTypeM (zonkTcTypeToType env2) local
-       ; (env3, new_co_fn)   <- zonkCoFn env2 co_fn
-       ; new_ms              <- zonkMatchGroup env3 zonkLExpr ms
-           -- If there is a representation polymorphism problem, it will
-           -- be caught here:
-       ; new_poly_id         <- zonkIdBndr env2 poly
-       ; new_prags           <- zonkSpecPrags env2 prags
-       ; let new_val_bind = L bind_loc (bind { fun_id      = L loc new_local
-                                             , fun_matches = new_ms
-                                             , fun_co_fn   = new_co_fn })
-       ; return (AbsBindsSig { abs_tvs         = new_tyvars
-                             , abs_ev_vars     = new_evs
-                             , abs_sig_export  = new_poly_id
-                             , abs_sig_prags   = new_prags
-                             , abs_sig_ev_bind = new_ev_bind
-                             , abs_sig_bind    = new_val_bind  }) }
-
-  | otherwise
-  = pprPanic "zonk_bind" (ppr outer_bind)
-
 zonk_bind env (PatSynBind bind@(PSB { psb_id = L loc id
                                     , psb_args = details
                                     , psb_def = lpat
@@ -583,10 +565,11 @@ zonkMatch :: ZonkEnv
           -> (ZonkEnv -> Located (body (GHC GhcTcId)) -> TcM (Located (body (GHC GhcTc))))
           -> LMatch GhcTcId (Located (body (GHC GhcTcId)))
           -> TcM (LMatch GhcTc (Located (body (GHC GhcTc))))
-zonkMatch env zBody (L loc (Match mf pats _ grhss))
+zonkMatch env zBody (L loc match@(Match { m_pats = pats, m_grhss = grhss }))
   = do  { (env1, new_pats) <- zonkPats env pats
         ; new_grhss <- zonkGRHSs env1 zBody grhss
-        ; return (L loc (Match mf new_pats Nothing new_grhss)) }
+        ; return (L loc (match { m_pats = new_pats, m_type = Nothing
+                               , m_grhss = new_grhss })) }
 
 -------------------------------------------------------------------------
 zonkGRHSs :: ZonkEnv
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 7c50888fc3..23eaee8bae 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -31,10 +31,12 @@ module TcHsType (
         tcHsLiftedType,   tcHsOpenType,
         tcHsLiftedTypeNC, tcHsOpenTypeNC,
         tcLHsType, tcCheckLHsType,
-        tcHsContext, tcLHsPredType, tcInferApps, tcInferArgs,
+        tcHsContext, tcLHsPredType, tcInferApps, tcTyApps,
         solveEqualities, -- useful re-export
 
-        kindGeneralize,
+        typeLevelMode, kindLevelMode,
+
+        kindGeneralize, checkExpectedKindX, instantiateTyUntilN,
 
         -- Sort-checking kinds
         tcLHsKindSig,
@@ -270,11 +272,12 @@ tcHsClsInstType user_ctxt hs_inst_ty
 -- Used for 'VECTORISE [SCALAR] instance' declarations
 tcHsVectInst :: LHsSigType GhcRn -> TcM (Class, [Type])
 tcHsVectInst ty
-  | Just (L _ cls_name, tys) <- hsTyGetAppHead_maybe (hsSigType ty)
+  | let hs_cls_ty = hsSigType ty
+  , Just (L _ cls_name, tys) <- hsTyGetAppHead_maybe hs_cls_ty
     -- Ignoring the binders looks pretty dodgy to me
   = do { (cls, cls_kind) <- tcClass cls_name
        ; (applied_class, _res_kind)
-           <- tcInferApps typeLevelMode cls_name (mkClassPred cls []) cls_kind tys
+           <- tcTyApps typeLevelMode hs_cls_ty (mkClassPred cls []) cls_kind tys
        ; case tcSplitTyConApp_maybe applied_class of
            Just (_tc, args) -> ASSERT( _tc == classTyCon cls )
                                return (cls, args)
@@ -319,7 +322,7 @@ tcHsOpenTypeNC   ty = do { ek <- newOpenTypeKind
 tcHsLiftedTypeNC ty = tc_lhs_type typeLevelMode ty liftedTypeKind
 
 -- Like tcHsType, but takes an expected kind
-tcCheckLHsType :: LHsType GhcRn -> Kind -> TcM Type
+tcCheckLHsType :: LHsType GhcRn -> Kind -> TcM TcType
 tcCheckLHsType hs_ty exp_kind
   = addTypeCtxt hs_ty $
     tc_lhs_type typeLevelMode hs_ty exp_kind
@@ -468,13 +471,13 @@ tc_infer_hs_type mode (HsAppTy ty1 ty2)
   = do { let (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2]
        ; (fun_ty', fun_kind) <- tc_infer_lhs_type mode fun_ty
        ; fun_kind' <- zonkTcType fun_kind
-       ; tcInferApps mode fun_ty fun_ty' fun_kind' arg_tys }
+       ; tcTyApps mode fun_ty fun_ty' fun_kind' arg_tys }
 tc_infer_hs_type mode (HsParTy t)     = tc_infer_lhs_type mode t
-tc_infer_hs_type mode (HsOpTy lhs (L _ op) rhs)
+tc_infer_hs_type mode (HsOpTy lhs (L loc_op op) rhs)
   | not (op `hasKey` funTyConKey)
   = do { (op', op_kind) <- tcTyVar mode op
        ; op_kind' <- zonkTcType op_kind
-       ; tcInferApps mode op op' op_kind' [lhs, rhs] }
+       ; tcTyApps mode (noLoc $ HsTyVar NotPromoted (L loc_op op)) op' op_kind' [lhs, rhs] }
 tc_infer_hs_type mode (HsKindSig ty sig)
   = do { sig' <- tc_lhs_kind (kindLevel mode) sig
        ; ty' <- tc_lhs_type mode ty sig'
@@ -510,11 +513,11 @@ tc_fun_type mode ty1 ty2 exp_kind = case mode_level mode of
        ; res_k <- newOpenTypeKind
        ; ty1' <- tc_lhs_type mode ty1 arg_k
        ; ty2' <- tc_lhs_type mode ty2 res_k
-       ; checkExpectedKind (mkFunTy ty1' ty2') liftedTypeKind exp_kind }
+       ; checkExpectedKind (HsFunTy ty1 ty2) (mkFunTy ty1' ty2') liftedTypeKind exp_kind }
   KindLevel ->  -- no representation polymorphism in kinds. yet.
     do { ty1' <- tc_lhs_type mode ty1 liftedTypeKind
        ; ty2' <- tc_lhs_type mode ty2 liftedTypeKind
-       ; checkExpectedKind (mkFunTy ty1' ty2') liftedTypeKind exp_kind }
+       ; checkExpectedKind (HsFunTy ty1 ty2) (mkFunTy ty1' ty2') liftedTypeKind exp_kind }
 
 ------------------------------------------
 -- See also Note [Bidirectional type checking]
@@ -579,30 +582,30 @@ tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_bodyy = ty }) exp_kind
                 else do { ek <- newOpenTypeKind
                                 -- The body kind (result of the function)
                                 -- can be * or #, hence newOpenTypeKind
-                        ; ty <- tc_lhs_type mode ty ek
-                        ; checkExpectedKind ty liftedTypeKind exp_kind }
+                        ; ty' <- tc_lhs_type mode ty ek
+                        ; checkExpectedKind (unLoc ty) ty' liftedTypeKind exp_kind }
 
        ; return (mkPhiTy ctxt' ty') }
 
 --------- Lists, arrays, and tuples
-tc_hs_type mode (HsListTy elt_ty) exp_kind
+tc_hs_type mode rn_ty@(HsListTy elt_ty) exp_kind
   = do { tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind
        ; checkWiredInTyCon listTyCon
-       ; checkExpectedKind (mkListTy tau_ty) liftedTypeKind exp_kind }
+       ; checkExpectedKind rn_ty (mkListTy tau_ty) liftedTypeKind exp_kind }
 
-tc_hs_type mode (HsPArrTy elt_ty) exp_kind
+tc_hs_type mode rn_ty@(HsPArrTy elt_ty) exp_kind
   = do { MASSERT( isTypeLevel (mode_level mode) )
        ; tau_ty <- tc_lhs_type mode elt_ty liftedTypeKind
        ; checkWiredInTyCon parrTyCon
-       ; checkExpectedKind (mkPArrTy tau_ty) liftedTypeKind exp_kind }
+       ; checkExpectedKind rn_ty (mkPArrTy tau_ty) liftedTypeKind exp_kind }
 
 -- See Note [Distinguishing tuple kinds] in HsTypes
 -- See Note [Inferring tuple kinds]
-tc_hs_type mode (HsTupleTy HsBoxedOrConstraintTuple hs_tys) exp_kind
+tc_hs_type mode rn_ty@(HsTupleTy HsBoxedOrConstraintTuple hs_tys) exp_kind
      -- (NB: not zonking before looking at exp_k, to avoid left-right bias)
   | Just tup_sort <- tupKindSort_maybe exp_kind
   = traceTc "tc_hs_type tuple" (ppr hs_tys) >>
-    tc_tuple mode tup_sort hs_tys exp_kind
+    tc_tuple rn_ty mode tup_sort hs_tys exp_kind
   | otherwise
   = do { traceTc "tc_hs_type tuple 2" (ppr hs_tys)
        ; (tys, kinds) <- mapAndUnzipM (tc_infer_lhs_type mode) hs_tys
@@ -620,14 +623,14 @@ tc_hs_type mode (HsTupleTy HsBoxedOrConstraintTuple hs_tys) exp_kind
          -- In the [] case, it's not clear what the kind is, so guess *
 
        ; tys' <- sequence [ setSrcSpan loc $
-                            checkExpectedKind ty kind arg_kind
-                          | ((L loc _),ty,kind) <- zip3 hs_tys tys kinds ]
+                            checkExpectedKind hs_ty ty kind arg_kind
+                          | ((L loc hs_ty),ty,kind) <- zip3 hs_tys tys kinds ]
 
-       ; finish_tuple tup_sort tys' (map (const arg_kind) tys') exp_kind }
+       ; finish_tuple rn_ty tup_sort tys' (map (const arg_kind) tys') exp_kind }
 
 
-tc_hs_type mode (HsTupleTy hs_tup_sort tys) exp_kind
-  = tc_tuple mode tup_sort tys exp_kind
+tc_hs_type mode rn_ty@(HsTupleTy hs_tup_sort tys) exp_kind
+  = tc_tuple rn_ty mode tup_sort tys exp_kind
   where
     tup_sort = case hs_tup_sort of  -- Fourth case dealt with above
                   HsUnboxedTuple    -> UnboxedTuple
@@ -635,28 +638,29 @@ tc_hs_type mode (HsTupleTy hs_tup_sort tys) exp_kind
                   HsConstraintTuple -> ConstraintTuple
                   _                 -> panic "tc_hs_type HsTupleTy"
 
-tc_hs_type mode (HsSumTy hs_tys) exp_kind
+tc_hs_type mode rn_ty@(HsSumTy hs_tys) exp_kind
   = do { let arity = length hs_tys
        ; arg_kinds <- mapM (\_ -> newOpenTypeKind) hs_tys
        ; tau_tys   <- zipWithM (tc_lhs_type mode) hs_tys arg_kinds
        ; let arg_reps = map (getRuntimeRepFromKind "tc_hs_type HsSumTy") arg_kinds
              arg_tys  = arg_reps ++ tau_tys
-       ; checkExpectedKind (mkTyConApp (sumTyCon arity) arg_tys)
+       ; checkExpectedKind rn_ty
+                           (mkTyConApp (sumTyCon arity) arg_tys)
                            (unboxedSumKind arg_reps)
                            exp_kind
        }
 
 --------- Promoted lists and tuples
-tc_hs_type mode (HsExplicitListTy _ _k tys) exp_kind
+tc_hs_type mode rn_ty@(HsExplicitListTy _ _k tys) exp_kind
   = do { tks <- mapM (tc_infer_lhs_type mode) tys
-       ; (taus', kind) <- unifyKinds tks
+       ; (taus', kind) <- unifyKinds tys tks
        ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus')
-       ; checkExpectedKind ty (mkListTy kind) exp_kind }
+       ; checkExpectedKind rn_ty ty (mkListTy kind) exp_kind }
   where
     mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]
     mk_nil  k     = mkTyConApp (promoteDataCon nilDataCon) [k]
 
-tc_hs_type mode (HsExplicitTupleTy _ tys) exp_kind
+tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
   -- using newMetaKindVar means that we force instantiations of any polykinded
   -- types. At first, I just used tc_infer_lhs_type, but that led to #11255.
   = do { ks   <- replicateM arity newMetaKindVar
@@ -664,35 +668,35 @@ tc_hs_type mode (HsExplicitTupleTy _ tys) exp_kind
        ; let kind_con   = tupleTyCon           Boxed arity
              ty_con     = promotedTupleDataCon Boxed arity
              tup_k      = mkTyConApp kind_con ks
-       ; checkExpectedKind (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }
+       ; checkExpectedKind rn_ty (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }
   where
     arity = length tys
 
 --------- Constraint types
-tc_hs_type mode (HsIParamTy (L _ n) ty) exp_kind
+tc_hs_type mode rn_ty@(HsIParamTy (L _ n) ty) exp_kind
   = do { MASSERT( isTypeLevel (mode_level mode) )
        ; ty' <- tc_lhs_type mode ty liftedTypeKind
        ; let n' = mkStrLitTy $ hsIPNameFS n
        ; ipClass <- tcLookupClass ipClassName
-       ; checkExpectedKind (mkClassPred ipClass [n',ty'])
+       ; checkExpectedKind rn_ty (mkClassPred ipClass [n',ty'])
            constraintKind exp_kind }
 
-tc_hs_type mode (HsEqTy ty1 ty2) exp_kind
+tc_hs_type mode rn_ty@(HsEqTy ty1 ty2) exp_kind
   = do { (ty1', kind1) <- tc_infer_lhs_type mode ty1
        ; (ty2', kind2) <- tc_infer_lhs_type mode ty2
-       ; ty2'' <- checkExpectedKind ty2' kind2 kind1
+       ; ty2'' <- checkExpectedKind (unLoc ty2) ty2' kind2 kind1
        ; eq_tc <- tcLookupTyCon eqTyConName
        ; let ty' = mkNakedTyConApp eq_tc [kind1, ty1', ty2'']
-       ; checkExpectedKind ty' constraintKind exp_kind }
+       ; checkExpectedKind rn_ty ty' constraintKind exp_kind }
 
 --------- Literals
-tc_hs_type _ (HsTyLit (HsNumTy _ n)) exp_kind
+tc_hs_type _ rn_ty@(HsTyLit (HsNumTy _ n)) exp_kind
   = do { checkWiredInTyCon typeNatKindCon
-       ; checkExpectedKind (mkNumLitTy n) typeNatKind exp_kind }
+       ; checkExpectedKind rn_ty (mkNumLitTy n) typeNatKind exp_kind }
 
-tc_hs_type _ (HsTyLit (HsStrTy _ s)) exp_kind
+tc_hs_type _ rn_ty@(HsTyLit (HsStrTy _ s)) exp_kind
   = do { checkWiredInTyCon typeSymbolKindCon
-       ; checkExpectedKind (mkStrLitTy s) typeSymbolKind exp_kind }
+       ; checkExpectedKind rn_ty (mkStrLitTy s) typeSymbolKind exp_kind }
 
 --------- Potentially kind-polymorphic types: call the "up" checker
 -- See Note [Future-proofing the type checker]
@@ -723,7 +727,7 @@ tcWildCardOcc wc_info exp_kind
 tc_infer_hs_type_ek :: TcTyMode -> HsType GhcRn -> TcKind -> TcM TcType
 tc_infer_hs_type_ek mode ty ek
   = do { (ty', k) <- tc_infer_hs_type mode ty
-       ; checkExpectedKind ty' k ek }
+       ; checkExpectedKind ty ty' k ek }
 
 ---------------------------
 tupKindSort_maybe :: TcKind -> Maybe TupleSort
@@ -734,23 +738,24 @@ tupKindSort_maybe k
   | isLiftedTypeKind k = Just BoxedTuple
   | otherwise          = Nothing
 
-tc_tuple :: TcTyMode -> TupleSort -> [LHsType GhcRn] -> TcKind -> TcM TcType
-tc_tuple mode tup_sort tys exp_kind
+tc_tuple :: HsType GhcRn -> TcTyMode -> TupleSort -> [LHsType GhcRn] -> TcKind -> TcM TcType
+tc_tuple rn_ty mode tup_sort tys exp_kind
   = do { arg_kinds <- case tup_sort of
            BoxedTuple      -> return (nOfThem arity liftedTypeKind)
            UnboxedTuple    -> mapM (\_ -> newOpenTypeKind) tys
            ConstraintTuple -> return (nOfThem arity constraintKind)
        ; tau_tys <- zipWithM (tc_lhs_type mode) tys arg_kinds
-       ; finish_tuple tup_sort tau_tys arg_kinds exp_kind }
+       ; finish_tuple rn_ty tup_sort tau_tys arg_kinds exp_kind }
   where
     arity   = length tys
 
-finish_tuple :: TupleSort
+finish_tuple :: HsType GhcRn
+             -> TupleSort
              -> [TcType]    -- ^ argument types
              -> [TcKind]    -- ^ of these kinds
              -> TcKind      -- ^ expected kind of the whole tuple
              -> TcM TcType
-finish_tuple tup_sort tau_tys tau_kinds exp_kind
+finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind
   = do { traceTc "finish_tuple" (ppr res_kind $$ ppr tau_kinds $$ ppr exp_kind)
        ; let arg_tys  = case tup_sort of
                    -- See also Note [Unboxed tuple RuntimeRep vars] in TyCon
@@ -766,7 +771,7 @@ finish_tuple tup_sort tau_tys tau_kinds exp_kind
                                ; checkWiredInTyCon tc
                                ; return tc }
            UnboxedTuple  -> return (tupleTyCon Unboxed arity)
-       ; checkExpectedKind (mkTyConApp tycon arg_tys) res_kind exp_kind }
+       ; checkExpectedKind rn_ty (mkTyConApp tycon arg_tys) res_kind exp_kind }
   where
     arity = length tau_tys
     tau_reps = map (getRuntimeRepFromKind "finish_tuple") tau_kinds
@@ -783,128 +788,125 @@ bigConstraintTuple arity
 
 ---------------------------
 -- | Apply a type of a given kind to a list of arguments. This instantiates
--- invisible parameters as necessary. However, it does *not* necessarily
--- apply all the arguments, if the kind runs out of binders.
--- Never calls 'matchExpectedFunKind'; when the kind runs out of binders,
--- this stops processing.
+-- invisible parameters as necessary. Always consumes all the arguments,
+-- using matchExpectedFunKind as necessary.
 -- This takes an optional @VarEnv Kind@ which maps kind variables to kinds.
 -- These kinds should be used to instantiate invisible kind variables;
 -- they come from an enclosing class for an associated type/data family.
--- This version will instantiate all invisible arguments left over after
--- the visible ones. Used only when typechecking type/data family patterns
--- (where we need to instantiate all remaining invisible parameters; for
--- example, consider @type family F :: k where F = Int; F = Maybe@. We
--- need to instantiate the @k@.)
-tcInferArgs :: Outputable fun
-            => fun                      -- ^ the function
-            -> [TyConBinder]            -- ^ function kind's binders
-            -> Maybe (VarEnv Kind)      -- ^ possibly, kind info (see above)
-            -> [LHsType GhcRn]          -- ^ args
-            -> TcM (TCvSubst, [TyBinder], [TcType], [LHsType GhcRn], Int)
-               -- ^ (instantiating subst, un-insted leftover binders,
-               --   typechecked args, untypechecked args, n)
-tcInferArgs fun tc_binders mb_kind_info args
-  = do { let binders = tyConBindersTyBinders tc_binders  -- UGH!
-       ; (subst, leftover_binders, args', leftovers, n)
-           <- tc_infer_args typeLevelMode fun binders mb_kind_info args 1
-        -- now, we need to instantiate any remaining invisible arguments
-       ; let (invis_bndrs, other_binders) = break isVisibleBinder leftover_binders
-       ; (subst', invis_args)
-           <- tcInstBinders subst mb_kind_info invis_bndrs
-       ; return ( subst'
-                , other_binders
-                , args' `chkAppend` invis_args
-                , leftovers, n ) }
-
--- | See comments for 'tcInferArgs'. But this version does not instantiate
--- any remaining invisible arguments.
-tc_infer_args :: Outputable fun
-              => TcTyMode
-              -> fun                      -- ^ the function
-              -> [TyBinder]               -- ^ function kind's binders (zonked)
-              -> Maybe (VarEnv Kind)      -- ^ possibly, kind info (see above)
-              -> [LHsType GhcRn]          -- ^ args
-              -> Int                      -- ^ number to start arg counter at
-              -> TcM (TCvSubst, [TyBinder], [TcType], [LHsType GhcRn], Int)
-tc_infer_args mode orig_ty binders mb_kind_info orig_args n0
-  = go emptyTCvSubst binders orig_args n0 []
+tcInferApps :: TcTyMode
+            -> Maybe (VarEnv Kind)  -- ^ Possibly, kind info (see above)
+            -> LHsType GhcRn        -- ^ Function (for printing only)
+            -> TcType               -- ^ Function (could be knot-tied)
+            -> TcKind               -- ^ Function kind (zonked)
+            -> [LHsType GhcRn]      -- ^ Args
+            -> TcM (TcType, [TcType], TcKind) -- ^ (f args, args, result kind)
+tcInferApps mode mb_kind_info orig_ty ty ki args
+  = do { traceTc "tcInferApps" (ppr orig_ty $$ ppr args $$ ppr ki)
+       ; go [] [] orig_subst ty orig_ki_binders orig_inner_ki args 1 }
   where
-    go subst binders []   n acc
-      = return ( subst, binders, reverse acc, [], n )
-    -- when we call this when checking type family patterns, we really
-    -- do want to instantiate all invisible arguments. During other
-    -- typechecking, we don't.
-
-    go subst (binder:binders) all_args@(arg:args) n acc
-      | isInvisibleBinder binder
-      = do { traceTc "tc_infer_args (invis)" (ppr binder)
-           ; (subst', arg') <- tcInstBinder mb_kind_info subst binder
-           ; go subst' binders all_args n (arg' : acc) }
+    orig_subst                       = mkEmptyTCvSubst $ mkInScopeSet $ tyCoVarsOfType ki
+    (orig_ki_binders, orig_inner_ki) = tcSplitPiTys ki
+
+    go :: [LHsType GhcRn] -- already type-checked args, in reverse order, for errors
+       -> [TcType]        -- already type-checked args, in reverse order
+       -> TCvSubst        -- instantiating substitution
+       -> TcType          -- function applied to some args, could be knot-tied
+       -> [TyBinder]      -- binders in function kind (both vis. and invis.)
+       -> TcKind          -- function kind body (not a Pi-type)
+       -> [LHsType GhcRn] -- un-type-checked args
+       -> Int             -- the # of the next argument
+       -> TcM (TcType, [TcType], TcKind)  -- same as overall return type
+
+      -- no user-written args left. We're done!
+    go _acc_hs_args acc_args subst fun ki_binders inner_ki [] _
+      = return (fun, reverse acc_args, substTy subst $ mkPiTys ki_binders inner_ki)
+
+      -- The function's kind has a binder. Is it visible or invisible?
+    go acc_hs_args acc_args subst fun (ki_binder:ki_binders) inner_ki
+       all_args@(arg:args) n
+      | isInvisibleBinder ki_binder
+        -- It's invisible. Instantiate.
+      = do { traceTc "tcInferApps (invis)" (ppr ki_binder $$ ppr subst)
+           ; (subst', arg') <- tcInstBinder mb_kind_info subst ki_binder
+           ; go acc_hs_args (arg' : acc_args) subst' (mkNakedAppTy fun arg')
+                ki_binders inner_ki all_args n }
 
       | otherwise
-      = do { traceTc "tc_infer_args (vis)" (ppr binder $$ ppr arg)
+        -- It's visible. Check the next user-written argument
+      = do { traceTc "tcInferApps (vis)" (ppr ki_binder $$ ppr arg $$ ppr subst)
            ; arg' <- addErrCtxt (funAppCtxt orig_ty arg n) $
-                     tc_lhs_type mode arg (substTyUnchecked subst $
-                                           tyBinderType binder)
-           ; let subst' = extendTvSubstBinder subst binder arg'
-           ; go subst' binders args (n+1) (arg' : acc) }
+                     tc_lhs_type mode arg (substTy subst $ tyBinderType ki_binder)
+           ; let subst' = extendTvSubstBinderAndInScope subst ki_binder arg'
+           ; go (arg : acc_hs_args) (arg' : acc_args) subst' (mkNakedAppTy fun arg')
+                ki_binders inner_ki args (n+1) }
 
-    go subst [] all_args n acc
-      = return (subst, [], reverse acc, all_args, n)
+       -- We've run out of known binders in the functions's kind.
+    go acc_hs_args acc_args subst fun [] inner_ki all_args n
+      | not (null new_ki_binders)
+         -- But, after substituting, we have more binders.
+      = go acc_hs_args acc_args zapped_subst fun new_ki_binders new_inner_ki all_args n
+
+      | otherwise
+         -- Even after substituting, still no binders. Use matchExpectedFunKind
+      = do { traceTc "tcInferApps (no binder)" (ppr new_inner_ki $$ ppr zapped_subst)
+           ; (co, arg_k, res_k)
+               <- matchExpectedFunKind (mkHsAppTys orig_ty (reverse acc_hs_args))
+                                       substed_inner_ki
+           ; let subst' = zapped_subst `extendTCvInScopeSet` tyCoVarsOfTypes [arg_k, res_k]
+           ; go acc_hs_args acc_args subst' (fun `mkNakedCastTy` co)
+                [mkAnonBinder arg_k] res_k all_args n }
+      where
+        substed_inner_ki               = substTy subst inner_ki
+        (new_ki_binders, new_inner_ki) = tcSplitPiTys substed_inner_ki
+        zapped_subst                   = zapTCvSubst subst
 
 -- | Applies a type to a list of arguments.
 -- Always consumes all the arguments, using 'matchExpectedFunKind' as
 -- necessary. If you wish to apply a type to a list of HsTypes, this is
 -- your function.
 -- Used for type-checking types only.
-tcInferApps :: Outputable fun
-            => TcTyMode
-            -> fun                  -- ^ Function (for printing only)
-            -> TcType               -- ^ Function (could be knot-tied)
-            -> TcKind               -- ^ Function kind (zonked)
-            -> [LHsType GhcRn]      -- ^ Args
-            -> TcM (TcType, TcKind) -- ^ (f args, result kind)
-tcInferApps mode orig_ty ty ki args = go ty ki args 1
-  where
-    go fun fun_kind []   _ = return (fun, fun_kind)
-    go fun fun_kind args n
-      | let (binders, res_kind) = splitPiTys fun_kind
-      , not (null binders)
-      = do { (subst, leftover_binders, args', leftover_args, n')
-                <- tc_infer_args mode orig_ty binders Nothing args n
-           ; let fun_kind' = substTyUnchecked subst $
-                             mkPiTys leftover_binders res_kind
-           ; go (mkNakedAppTys fun args') fun_kind' leftover_args n' }
-
-    go fun fun_kind all_args@(arg:args) n
-      = do { (co, arg_k, res_k) <- matchExpectedFunKind (length all_args)
-                                                        fun fun_kind
-           ; arg' <- addErrCtxt (funAppCtxt orig_ty arg n) $
-                     tc_lhs_type mode arg arg_k
-           ; go (mkNakedAppTy (fun `mkNakedCastTy` co) arg')
-                res_k args (n+1) }
+tcTyApps :: TcTyMode
+         -> LHsType GhcRn        -- ^ Function (for printing only)
+         -> TcType               -- ^ Function (could be knot-tied)
+         -> TcKind               -- ^ Function kind (zonked)
+         -> [LHsType GhcRn]      -- ^ Args
+         -> TcM (TcType, TcKind) -- ^ (f args, result kind)
+tcTyApps mode orig_ty ty ki args
+  = do { (ty', _args, ki') <- tcInferApps mode Nothing orig_ty ty ki args
+       ; return (ty', ki') }
 
 --------------------------
-checkExpectedKind :: TcType               -- the type whose kind we're checking
-                  -> TcKind               -- the known kind of that type, k
-                  -> TcKind               -- the expected kind, exp_kind
-                  -> TcM TcType    -- a possibly-inst'ed, casted type :: exp_kind
+-- like checkExpectedKindX, but returns only the final type; convenient wrapper
+checkExpectedKind :: HsType GhcRn
+                  -> TcType
+                  -> TcKind
+                  -> TcKind
+                  -> TcM TcType
+checkExpectedKind hs_ty ty act exp = fstOf3 <$> checkExpectedKindX Nothing (ppr hs_ty) ty act exp
+
+checkExpectedKindX :: Maybe (VarEnv Kind)  -- Possibly, instantiations for kind vars
+                   -> SDoc                 -- HsType whose kind we're checking
+                   -> TcType               -- the type whose kind we're checking
+                   -> TcKind               -- the known kind of that type, k
+                   -> TcKind               -- the expected kind, exp_kind
+                   -> TcM (TcType, [TcType], TcCoercionN)
+    -- (an possibly-inst'ed, casted type :: exp_kind, the new args, the coercion)
 -- Instantiate a kind (if necessary) and then call unifyType
 --      (checkExpectedKind ty act_kind exp_kind)
 -- checks that the actual kind act_kind is compatible
 --      with the expected kind exp_kind
-checkExpectedKind ty act_kind exp_kind
- = do { (ty', act_kind') <- instantiate ty act_kind exp_kind
+checkExpectedKindX mb_kind_env pp_hs_ty ty act_kind exp_kind
+ = do { (ty', new_args, act_kind') <- instantiate ty act_kind exp_kind
       ; let origin = TypeEqOrigin { uo_actual   = act_kind'
                                   , uo_expected = exp_kind
-                                  , uo_thing    = Just $ mkTypeErrorThing ty'
-                                  }
-      ; co_k <- uType origin KindLevel act_kind' exp_kind
+                                  , uo_thing    = Just pp_hs_ty
+                                  , uo_visible  = True } -- the hs_ty is visible
+      ; co_k <- uType KindLevel origin act_kind' exp_kind
       ; traceTc "checkExpectedKind" (vcat [ ppr act_kind
                                           , ppr exp_kind
                                           , ppr co_k ])
       ; let result_ty = ty' `mkNakedCastTy` co_k
-      ; return result_ty }
+      ; return (result_ty, new_args, co_k) }
   where
     -- we need to make sure that both kinds have the same number of implicit
     -- foralls out front. If the actual kind has more, instantiate accordingly.
@@ -914,32 +916,50 @@ checkExpectedKind ty act_kind exp_kind
                 -> TcKind    -- of this kind
                 -> TcKind   -- but expected to be of this one
                 -> TcM ( TcType   -- the inst'ed type
+                       , [TcType] -- the new args
                        , TcKind ) -- its new kind
     instantiate ty act_ki exp_ki
       = let (exp_bndrs, _) = splitPiTysInvisible exp_ki in
-        instantiateTyN (length exp_bndrs) ty act_ki
-
--- | Instantiate a type to have at most @n@ invisible arguments.
-instantiateTyN :: Int    -- ^ @n@
-               -> TcType -- ^ the type
-               -> TcKind -- ^ its kind
-               -> TcM (TcType, TcKind)   -- ^ The inst'ed type with kind
-instantiateTyN n ty ki
-  = let (bndrs, inner_ki)            = splitPiTysInvisible ki
-        num_to_inst                  = length bndrs - n
-           -- NB: splitAt is forgiving with invalid numbers
-        (inst_bndrs, leftover_bndrs) = splitAt num_to_inst bndrs
+        instantiateTyUntilN mb_kind_env (length exp_bndrs) ty act_ki
+
+-- | Instantiate @n@ invisible arguments to a type. If @n <= 0@, no instantiation
+-- occurs. If @n@ is too big, then all available invisible arguments are instantiated.
+-- (In other words, this function is very forgiving about bad values of @n@.)
+instantiateTyN :: Maybe (VarEnv Kind)              -- ^ Predetermined instantiations
+                                                   -- (for assoc. type patterns)
+               -> Int                              -- ^ @n@
+               -> TcType                           -- ^ the type
+               -> [TyBinder] -> TcKind             -- ^ its kind
+               -> TcM (TcType, [TcType], TcKind)   -- ^ The inst'ed type, new args, kind
+instantiateTyN mb_kind_env n ty bndrs inner_ki
+  = let   -- NB: splitAt is forgiving with invalid numbers
+        (inst_bndrs, leftover_bndrs) = splitAt n bndrs
+        ki          = mkPiTys bndrs inner_ki
         empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType ki))
     in
-    if num_to_inst <= 0 then return (ty, ki) else
-    do { (subst, inst_args) <- tcInstBinders empty_subst Nothing inst_bndrs
+    if n <= 0 then return (ty, [], ki) else
+    do { (subst, inst_args) <- tcInstBinders empty_subst mb_kind_env inst_bndrs
        ; let rebuilt_ki = mkPiTys leftover_bndrs inner_ki
              ki'        = substTy subst rebuilt_ki
-       ; traceTc "instantiateTyN" (vcat [ ppr ty <+> dcolon <+> ppr ki
+       ; traceTc "instantiateTyN" (vcat [ ppr ki
+                                        , ppr n
                                         , ppr subst
                                         , ppr rebuilt_ki
                                         , ppr ki' ])
-       ; return (mkNakedAppTys ty inst_args, ki') }
+       ; return (mkNakedAppTys ty inst_args, inst_args, ki') }
+
+-- | Instantiate a type to have at most @n@ invisible arguments.
+instantiateTyUntilN :: Maybe (VarEnv Kind)   -- ^ Possibly, instantiations for vars
+                    -> Int         -- ^ @n@
+                    -> TcType      -- ^ the type
+                    -> TcKind      -- ^ its kind
+                    -> TcM (TcType, [TcType], TcKind)   -- ^ The inst'ed type, new args,
+                                                        -- final kind
+instantiateTyUntilN mb_kind_env n ty ki
+  = let (bndrs, inner_ki) = splitPiTysInvisible ki
+        num_to_inst       = length bndrs - n
+    in
+    instantiateTyN mb_kind_env num_to_inst ty bndrs inner_ki
 
 ---------------------------
 tcHsContext :: LHsContext GhcRn -> TcM [PredType]
@@ -1012,8 +1032,8 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
 
     -- if we are type-checking a type family tycon, we must instantiate
     -- any invisible arguments right away. Otherwise, we get #11246
-    handle_tyfams :: TyCon   -- the tycon to instantiate (might be loopy)
-                  -> TyCon   -- a non-loopy version of the tycon
+    handle_tyfams :: TyCon     -- the tycon to instantiate (might be loopy)
+                  -> TcTyCon   -- a non-loopy version of the tycon
                   -> TcM (TcType, TcKind)
     handle_tyfams tc tc_tc
       | mightBeUnsaturatedTyCon tc_tc
@@ -1021,7 +1041,8 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
            ; return (ty, tc_kind) }
 
       | otherwise
-      = do { (tc_ty, kind) <- instantiateTyN 0 ty tc_kind
+      = do { (tc_ty, _, kind) <- instantiateTyN Nothing (length (tyConBinders tc_tc))
+                                                ty tc_kind_bndrs tc_inner_ki
            -- tc and tc_ty must not be traced here, because that would
            -- force the evaluation of a potentially knot-tied variable (tc),
            -- and the typechecker would hang, as per #11708
@@ -1029,8 +1050,9 @@ tcTyVar mode name         -- Could be a tyvar, a tycon, or a datacon
                                        , ppr kind ])
            ; return (tc_ty, kind) }
       where
-        ty      = mkNakedTyConApp tc []
-        tc_kind = tyConKind tc_tc
+        ty                           = mkNakedTyConApp tc []
+        tc_kind                      = tyConKind tc_tc
+        (tc_kind_bndrs, tc_inner_ki) = splitPiTysInvisible tc_kind
 
     get_loopy_tc :: Name -> TyCon -> TcM TyCon
     -- Return the knot-tied global TyCon if there is one
@@ -1232,7 +1254,7 @@ Help functions for type applications
 
 addTypeCtxt :: LHsType GhcRn -> TcM a -> TcM a
         -- Wrap a context around only if we want to show that contexts.
-        -- Omit invisble ones and ones user's won't grok
+        -- Omit invisible ones and ones user's won't grok
 addTypeCtxt (L _ ty) thing
   = addErrCtxt doc thing
   where
@@ -1418,13 +1440,13 @@ kcHsTyVarBndrs name flav cusk all_kind_vars
       = tcExtendTyVarEnv [tv] thing_inside
 
     kc_hs_tv :: HsTyVarBndr GhcRn -> TcM (TcTyVar, Bool)
-    kc_hs_tv (UserTyVar (L _ name))
+    kc_hs_tv (UserTyVar lname@(L _ name))
       = do { tv_pair@(tv, scoped) <- tcHsTyVarName Nothing name
 
               -- Open type/data families default their variables to kind *.
            ; when (open_fam && not scoped) $ -- (don't default class tyvars)
-             discardResult $ unifyKind (Just (mkTyVarTy tv)) liftedTypeKind
-                                                             (tyVarKind tv)
+             discardResult $ unifyKind (Just (HsTyVar NotPromoted lname)) liftedTypeKind
+                                       (tyVarKind tv)
 
            ; return tv_pair }
 
@@ -1578,7 +1600,7 @@ tcHsTyVarName m_kind name
            Just (ATyVar _ tv)
              -> do { whenIsJust m_kind $ \ kind ->
                      discardResult $
-                     unifyKind (Just (mkTyVarTy tv)) kind (tyVarKind tv)
+                     unifyKind (Just (HsTyVar NotPromoted (noLoc name))) kind (tyVarKind tv)
                    ; return (tv, True) }
            _ -> do { kind <- case m_kind of
                                Just kind -> return kind
@@ -1751,17 +1773,22 @@ tcTyClTyVars tycon_name thing_inside
          thing_inside binders res_kind }
 
 -----------------------------------
-tcDataKindSig :: Kind -> TcM ([TyConBinder], Kind)
+tcDataKindSig :: Bool  -- ^ Do we require the result to be *?
+              -> Kind -> TcM ([TyConBinder], Kind)
 -- GADT decls can have a (perhaps partial) kind signature
 --      e.g.  data T :: * -> * -> * where ...
 -- This function makes up suitable (kinded) type variables for
--- the argument kinds, and checks that the result kind is indeed *.
+-- the argument kinds, and checks that the result kind is indeed * if requested.
+-- (Otherwise, checks to make sure that the result kind is either * or a type variable.)
+-- See Note [Arity of data families] in FamInstEnv for more info.
 -- We use it also to make up argument type variables for for data instances.
 -- Never emits constraints.
 -- Returns the new TyVars, the extracted TyBinders, and the new, reduced
 -- result kind (which should always be Type or a synonym thereof)
-tcDataKindSig kind
-  = do  { checkTc (isLiftedTypeKind res_kind) (badKindSig kind)
+tcDataKindSig check_for_type kind
+  = do  { checkTc (isLiftedTypeKind res_kind || (not check_for_type &&
+                                                 isJust (tcGetCastedTyVar_maybe res_kind)))
+                  (badKindSig check_for_type kind)
         ; span <- getSrcSpanM
         ; us   <- newUniqueSupply
         ; rdr_env <- getLocalRdrEnv
@@ -1781,9 +1808,11 @@ tcDataKindSig kind
   where
     (tv_bndrs, res_kind) = splitPiTys kind
 
-badKindSig :: Kind -> SDoc
-badKindSig kind
- = hang (text "Kind signature on data type declaration has non-* return kind")
+badKindSig :: Bool -> Kind -> SDoc
+badKindSig check_for_type kind
+ = hang (sep [ text "Kind signature on data type declaration has non-*"
+             , (if check_for_type then empty else text "and non-variable") <+>
+               text "return kind" ])
         2 (ppr kind)
 
 {-
@@ -2050,11 +2079,11 @@ in-scope variables that it should not unify with, but it's fiddly.
 
 -}
 
-unifyKinds :: [(TcType, TcKind)] -> TcM ([TcType], TcKind)
-unifyKinds act_kinds
+unifyKinds :: [LHsType GhcRn] -> [(TcType, TcKind)] -> TcM ([TcType], TcKind)
+unifyKinds rn_tys act_kinds
   = do { kind <- newMetaKindVar
-       ; let check (ty, act_kind) = checkExpectedKind ty act_kind kind
-       ; tys' <- mapM check act_kinds
+       ; let check rn_ty (ty, act_kind) = checkExpectedKind (unLoc rn_ty) ty act_kind kind
+       ; tys' <- zipWithM check rn_tys act_kinds
        ; return (tys', kind) }
 
 {-
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index 12fa7e75c3..3b433052ef 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -488,7 +488,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
         ; let defined_ats = mkNameSet (map (tyFamInstDeclName . unLoc) ats)
                             `unionNameSet`
                             mkNameSet (map (unLoc . dfid_tycon . unLoc) adts)
-        ; tyfam_insts1 <- mapM (tcATDefault True loc mini_subst defined_ats)
+        ; tyfam_insts1 <- mapM (tcATDefault loc mini_subst defined_ats)
                                (classATItems clas)
 
         -- Finally, construct the Core representation of the instance.
@@ -626,9 +626,10 @@ tcDataFamInstDecl mb_clsinfo
     (L loc decl@(DataFamInstDecl
        { dfid_pats = pats
        , dfid_tycon = fam_tc_name
-       , dfid_defn = defn@HsDataDefn { dd_ND = new_or_data, dd_cType = cType
-                                     , dd_ctxt = ctxt, dd_cons = cons
-                                     , dd_derivs = derivs } }))
+       , dfid_fixity = fixity
+       , dfid_defn = HsDataDefn { dd_ND = new_or_data, dd_cType = cType
+                                , dd_ctxt = ctxt, dd_cons = cons
+                                , dd_kindSig = m_ksig, dd_derivs = derivs } }))
   = setSrcSpan loc             $
     tcAddDataFamInstCtxt decl  $
     do { fam_tc <- tcFamInstDeclCombined mb_clsinfo fam_tc_name
@@ -638,8 +639,9 @@ tcDataFamInstDecl mb_clsinfo
        ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)
 
          -- Kind check type patterns
+       ; let mb_kind_env = thdOf3 <$> mb_clsinfo
        ; tcFamTyPats (famTyConShape fam_tc) mb_clsinfo pats
-                     (kcDataDefn (unLoc fam_tc_name) pats defn) $
+                     (kcDataDefn mb_kind_env decl) $
              \tvs pats res_kind ->
     do { stupid_theta <- solveEqualities $ tcHsContext ctxt
 
@@ -655,17 +657,27 @@ tcDataFamInstDecl mb_clsinfo
        ; rep_tc_name <- newFamInstTyConName fam_tc_name pats'
        ; axiom_name  <- newFamInstAxiomName fam_tc_name [pats']
 
+         -- Deal with any kind signature.
+         -- See also Note [Arity of data families] in FamInstEnv
+       ; (extra_tcbs, final_res_kind) <- tcDataKindSig True res_kind'
+
        ; let (eta_pats, etad_tvs) = eta_reduce pats'
              eta_tvs              = filterOut (`elem` etad_tvs) tvs'
+                 -- NB: the "extra" tvs from tcDataKindSig would always be eta-reduced
+
              full_tvs             = eta_tvs ++ etad_tvs
                  -- Put the eta-removed tyvars at the end
                  -- Remember, tvs' is in arbitrary order (except kind vars are
                  -- first, so there is no reason to suppose that the etad_tvs
                  -- (obtained from the pats) are at the end (Trac #11148)
-             orig_res_ty          = mkTyConApp fam_tc pats'
+
+             extra_pats           = map (mkTyVarTy . binderVar) extra_tcbs
+             all_pats             = pats' `chkAppend` extra_pats
+             orig_res_ty          = mkTyConApp fam_tc all_pats
 
        ; (rep_tc, axiom) <- fixM $ \ ~(rec_rep_tc, _) ->
-           do { let ty_binders = mkTyConBindersPreferAnon full_tvs liftedTypeKind
+           do { let ty_binders = mkTyConBindersPreferAnon full_tvs res_kind'
+                                 `chkAppend` extra_tcbs
               ; data_cons <- tcConDecls rec_rep_tc
                                         (ty_binders, orig_res_ty) cons
               ; tc_rhs <- case new_or_data of
@@ -676,14 +688,14 @@ tcDataFamInstDecl mb_clsinfo
               ; let axiom  = mkSingleCoAxiom Representational
                                              axiom_name eta_tvs [] fam_tc eta_pats
                                              (mkTyConApp rep_tc (mkTyVarTys eta_tvs))
-                    parent = DataFamInstTyCon axiom fam_tc pats'
+                    parent = DataFamInstTyCon axiom fam_tc all_pats
 
 
-                      -- NB: Use the full_tvs from the pats. See bullet toward
+                      -- NB: Use the full ty_binders from the pats. See bullet toward
                       -- the end of Note [Data type families] in TyCon
                     rep_tc   = mkAlgTyCon rep_tc_name
                                           ty_binders liftedTypeKind
-                                          (map (const Nominal) full_tvs)
+                                          (map (const Nominal) ty_binders)
                                           (fmap unLoc cType) stupid_theta
                                           tc_rhs parent
                                           gadt_syntax
@@ -697,10 +709,10 @@ tcDataFamInstDecl mb_clsinfo
          -- Remember to check validity; no recursion to worry about here
          -- Check that left-hand sides are ok (mono-types, no type families,
          -- consistent instantiations, etc)
-       ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats'
+       ; checkValidFamPats mb_clsinfo fam_tc tvs' [] pats' extra_pats pp_hs_pats
 
          -- Result kind must be '*' (otherwise, we have too few patterns)
-       ; checkTc (isLiftedTypeKind res_kind') $
+       ; checkTc (isLiftedTypeKind final_res_kind) $
          tooFewParmsErr (tyConArity fam_tc)
 
        ; checkValidTyCon rep_tc
@@ -730,6 +742,7 @@ tcDataFamInstDecl mb_clsinfo
       = go pats (tv : etad_tvs)
     go pats etad_tvs = (reverse pats, etad_tvs)
 
+    pp_hs_pats = pprFamInstLHS fam_tc_name pats fixity (unLoc ctxt) m_ksig
 
 {- *********************************************************************
 *                                                                      *
@@ -876,7 +889,8 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
                                   , abs_ev_varsa = dfun_ev_vars
                                   , abs_exports = [export]
                                   , abs_ev_binds = []
-                                  , abs_binds = unitBag dict_bind }
+                                  , abs_binds = unitBag dict_bind
+                                  , abs_sig = True }
 
        ; return (unitBag (L loc main_bind) `unionBags` sc_meth_binds)
        }
@@ -1024,7 +1038,8 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds sc_theta
                                  , abs_ev_varsa  = dfun_evs
                                  , abs_exports  = [export]
                                  , abs_ev_binds = [dfun_ev_binds, local_ev_binds]
-                                 , abs_binds    = emptyBag }
+                                 , abs_binds    = emptyBag
+                                 , abs_sig      = False }
            ; return (sc_top_id, L loc bind, sc_implic) }
 
 -------------------
@@ -1361,17 +1376,18 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys
        ; spec_prags     <- tcSpecPrags global_meth_id prags
 
         ; let specs  = mk_meth_spec_prags global_meth_id spec_inst_prags spec_prags
-              export = ABE { abe_poly      = global_meth_id
-                           , abe_mono      = local_meth_id
-                           , abe_wrap      = idHsWrapper
-                           , abe_prags     = specs }
+              export = ABE { abe_poly  = global_meth_id
+                           , abe_mono  = local_meth_id
+                           , abe_wrap  = idHsWrapper
+                           , abe_prags = specs }
 
               local_ev_binds = TcEvBinds ev_binds_var
               full_bind = AbsBinds { abs_tvsa      = tyvars
                                    , abs_ev_varsa  = dfun_ev_vars
                                    , abs_exports  = [export]
                                    , abs_ev_binds = [dfun_ev_binds, local_ev_binds]
-                                   , abs_binds    = tc_bind }
+                                   , abs_binds    = tc_bind
+                                   , abs_sig      = True }
 
         ; return (global_meth_id, L bind_loc full_bind, Just meth_implic) }
   where
@@ -1416,7 +1432,8 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
        ; return (unitBag $ L (getLoc meth_bind) $
                  AbsBinds { abs_tvsa = [], abs_ev_varsa = []
                           , abs_exports = [export]
-                          , abs_binds = tc_bind, abs_ev_binds = [] }) }
+                          , abs_binds = tc_bind, abs_ev_binds = []
+                          , abs_sig = True }) }
 
   | otherwise  -- No instance signature
   = do { let ctxt = FunSigCtxt sel_name False
diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs
index e1550256c2..ed473fe7eb 100644
--- a/compiler/typecheck/TcInteract.hs
+++ b/compiler/typecheck/TcInteract.hs
@@ -528,7 +528,8 @@ solveOneFromTheOther ev_i ev_w
 
   | CtWanted { ctev_loc = loc_w } <- ev_w
   , prohibitedSuperClassSolve (ctEvLoc ev_i) loc_w
-  = return (IRDelete, False)
+  = do { traceTcS "prohibitedClassSolve1" (ppr ev_i $$ ppr ev_w)
+       ; return (IRDelete, False) }
 
   | CtWanted { ctev_dest = dest } <- ev_w
        -- Inert is Given or Wanted
@@ -537,9 +538,10 @@ solveOneFromTheOther ev_i ev_w
 
   | CtWanted { ctev_loc = loc_i } <- ev_i   -- Work item is Given
   , prohibitedSuperClassSolve (ctEvLoc ev_w) loc_i
-  = return (IRKeep, False)  -- Just discard the un-usable Given
-                            -- This never actually happens because
-                            -- Givens get processed first
+  = do { traceTcS "prohibitedClassSolve2" (ppr ev_i $$ ppr ev_w)
+       ; return (IRKeep, False) } -- Just discard the un-usable Given
+                                  -- This never actually happens because
+                                  -- Givens get processed first
 
   | CtWanted { ctev_dest = dest } <- ev_i
   = do { setWantedEvTerm dest (ctEvTerm ev_w)
@@ -878,6 +880,7 @@ interactDict inerts workItem@(CDictCan { cc_ev = ev_w, cc_class = cls, cc_tyargs
       -- we solve it from the solution in the inerts we just retrieved.
       Nothing ->  do
         { (inert_effect, stop_now) <- solveOneFromTheOther ctev_i ev_w
+        ; traceTcS "lookupInertDict" (ppr inert_effect <+> ppr stop_now)
         ; case inert_effect of
             IRKeep    -> return ()
             IRDelete  -> updInertDicts $ \ ds -> delDict ds cls tys
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 0a1de443b3..19b0381d2d 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -66,7 +66,6 @@ module TcMType (
   --------------------------------
   -- Zonking and tidying
   zonkTidyTcType, zonkTidyOrigin,
-  mkTypeErrorThing, mkTypeErrorThingArgs,
   tidyEvVar, tidyCt, tidySkolemInfo,
   skolemiseRuntimeUnk,
   zonkTcTyVar, zonkTcTyVars, zonkTcTyVarToTyVar,
@@ -1526,32 +1525,17 @@ zonkTidyTcType :: TidyEnv -> TcType -> TcM (TidyEnv, TcType)
 zonkTidyTcType env ty = do { ty' <- zonkTcType ty
                            ; return (tidyOpenType env ty') }
 
--- | Make an 'ErrorThing' storing a type.
-mkTypeErrorThing :: TcType -> ErrorThing
-mkTypeErrorThing ty = ErrorThing ty (Just $ length $ snd $ repSplitAppTys ty)
-                                 zonkTidyTcType
-   -- NB: Use *rep*splitAppTys, else we get #11313
-
--- | Make an 'ErrorThing' storing a type, with some extra args known about
-mkTypeErrorThingArgs :: TcType -> Int -> ErrorThing
-mkTypeErrorThingArgs ty num_args
-  = ErrorThing ty (Just $ (length $ snd $ repSplitAppTys ty) + num_args)
-               zonkTidyTcType
-
 zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)
 zonkTidyOrigin env (GivenOrigin skol_info)
   = do { skol_info1 <- zonkSkolemInfo skol_info
        ; let skol_info2 = tidySkolemInfo env skol_info1
        ; return (env, GivenOrigin skol_info2) }
 zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual   = act
-                                      , uo_expected = exp
-                                      , uo_thing    = m_thing })
+                                      , uo_expected = exp })
   = do { (env1, act') <- zonkTidyTcType env  act
        ; (env2, exp') <- zonkTidyTcType env1 exp
-       ; (env3, m_thing') <- zonkTidyErrorThing env2 m_thing
-       ; return ( env3, orig { uo_actual   = act'
-                             , uo_expected = exp'
-                             , uo_thing    = m_thing' }) }
+       ; return ( env2, orig { uo_actual   = act'
+                             , uo_expected = exp' }) }
 zonkTidyOrigin env (KindEqOrigin ty1 m_ty2 orig t_or_k)
   = do { (env1, ty1')   <- zonkTidyTcType env  ty1
        ; (env2, m_ty2') <- case m_ty2 of
@@ -1570,14 +1554,6 @@ zonkTidyOrigin env (FunDepOrigin2 p1 o1 p2 l2)
        ; return (env3, FunDepOrigin2 p1' o1' p2' l2) }
 zonkTidyOrigin env orig = return (env, orig)
 
-zonkTidyErrorThing :: TidyEnv -> Maybe ErrorThing
-                   -> TcM (TidyEnv, Maybe ErrorThing)
-zonkTidyErrorThing env (Just (ErrorThing thing n_args zonker))
-  = do { (env', thing') <- zonker env thing
-       ; return (env', Just $ ErrorThing thing' n_args zonker) }
-zonkTidyErrorThing env Nothing
-  = return (env, Nothing)
-
 ----------------
 tidyCt :: TidyEnv -> Ct -> Ct
 -- Used only in error reporting
diff --git a/compiler/typecheck/TcMatches.hs b/compiler/typecheck/TcMatches.hs
index d8ee608436..185bace9f4 100644
--- a/compiler/typecheck/TcMatches.hs
+++ b/compiler/typecheck/TcMatches.hs
@@ -99,10 +99,11 @@ tcMatchesFun fn@(L _ fun_name) matches exp_ty
     arity = matchGroupArity matches
     herald = text "The equation(s) for"
              <+> quotes (ppr fun_name) <+> text "have"
-    match_ctxt = MC { mc_what = FunRhs fn Prefix strictness, mc_body = tcBody }
+    what = FunRhs { mc_fun = fn, mc_fixity = Prefix, mc_strictness = strictness }
+    match_ctxt = MC { mc_what = what, mc_body = tcBody }
     strictness
       | [L _ match] <- unLoc $ mg_alts matches
-      , FunRhs{mc_strictness = SrcStrict} <- m_ctxt match
+      , FunRhs{ mc_strictness = SrcStrict } <- m_ctxt match
       = SrcStrict
       | otherwise
       = NoSrcStrict
@@ -231,11 +232,13 @@ tcMatch :: (Outputable (body (GHC GhcRn))) => TcMatchCtxt body
 tcMatch ctxt pat_tys rhs_ty match
   = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
   where
-    tc_match ctxt pat_tys rhs_ty match@(Match _ pats maybe_rhs_sig grhss)
+    tc_match ctxt pat_tys rhs_ty
+             match@(Match { m_pats = pats, m_type = maybe_rhs_sig, m_grhss = grhss })
       = add_match_ctxt match $
         do { (pats', grhss') <- tcPats (mc_what ctxt) pats pat_tys $
                                 tc_grhss ctxt maybe_rhs_sig grhss rhs_ty
-           ; return (Match (mc_what ctxt) pats' Nothing grhss') }
+           ; return (Match { m_ctxt = mc_what ctxt, m_pats = pats'
+                           , m_type = Nothing, m_grhss = grhss' }) }
 
     tc_grhss ctxt Nothing grhss rhs_ty
       = tcGRHSs ctxt grhss rhs_ty       -- No result signature
@@ -1134,4 +1137,4 @@ checkArgs fun (MG { mg_alts = L _ (match1:matches) })
     bad_matches = [m | m <- matches, args_in_match m /= n_args1]
 
     args_in_match :: LMatch GhcRn body -> Int
-    args_in_match (L _ (Match _ pats _ _)) = length pats
+    args_in_match (L _ (Match { m_pats = pats })) = length pats
diff --git a/compiler/typecheck/TcPat.hs b/compiler/typecheck/TcPat.hs
index 0d0e16a346..18b148d8b6 100644
--- a/compiler/typecheck/TcPat.hs
+++ b/compiler/typecheck/TcPat.hs
@@ -348,7 +348,7 @@ tc_pat penv (LazyPat pat) pat_ty thing_inside
 
         -- Check that the expected pattern type is itself lifted
         ; pat_ty <- readExpType pat_ty
-        ; _ <- unifyType noThing (typeKind pat_ty) liftedTypeKind
+        ; _ <- unifyType Nothing (typeKind pat_ty) liftedTypeKind
 
         ; return (LazyPat pat', res) }
 
@@ -382,7 +382,7 @@ tc_pat penv (ViewPat expr pat _) overall_pat_ty thing_inside
         ; let expr_orig = lexprCtOrigin expr
               herald    = text "A view pattern expression expects"
         ; (expr_wrap1, [inf_arg_ty], inf_res_ty)
-            <- matchActualFunTys herald expr_orig (Just expr) 1 expr'_inferred
+            <- matchActualFunTys herald expr_orig (Just (unLoc expr)) 1 expr'_inferred
             -- expr_wrap1 :: expr'_inferred "->" (inf_arg_ty -> inf_res_ty)
 
          -- check that overall pattern is more polymorphic than arg type
@@ -896,7 +896,7 @@ matchExpectedConTy (PE { pe_orig = orig }) data_tc exp_pat_ty
                                              ppr exp_pat_ty,
                                              ppr pat_ty,
                                              ppr pat_rho, ppr wrap])
-       ; co1 <- unifyType noThing (mkTyConApp fam_tc (substTys subst fam_args)) pat_rho
+       ; co1 <- unifyType Nothing (mkTyConApp fam_tc (substTys subst fam_args)) pat_rho
              -- co1 : T (ty1,ty2) ~N pat_rho
              -- could use tcSubType here... but it's the wrong way round
              -- for actual vs. expected in error messages.
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 95161816af..0004bee119 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -15,8 +15,7 @@ module TcPatSyn ( tcInferPatSynDecl, tcCheckPatSynDecl
 
 import HsSyn
 import TcPat
-import Type( mkTyVarBinders, mkEmptyTCvSubst
-           , tidyTyVarBinders, tidyTypes, tidyType )
+import Type( mkEmptyTCvSubst, tidyTyVarBinders, tidyTypes, tidyType )
 import TcRnMonad
 import TcSigs( emptyPragEnv, completeSigFromId )
 import TcEnv
@@ -81,8 +80,8 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
 
        ; let named_taus = (name, pat_ty) : map (\arg -> (getName arg, varType arg)) args
 
-       ; (qtvs, req_dicts, ev_binds) <- simplifyInfer tclvl NoRestrictions []
-                                                      named_taus wanted
+       ; (qtvs, req_dicts, ev_binds, _) <- simplifyInfer tclvl NoRestrictions []
+                                                         named_taus wanted
 
        ; let (ex_tvs, prov_dicts) = tcCollectEx lpat'
              ex_tv_set  = mkVarSet ex_tvs
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 9e7a560ba8..289c1516fd 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -2191,9 +2191,9 @@ tcRnExpr hsc_env mode rdr_expr
                   else return expr_ty } ;
 
     -- Generalise
-    ((qtvs, dicts, _), lie_top) <- captureTopConstraints $
-                                   {-# SCC "simplifyInfer" #-}
-                                   simplifyInfer tclvl
+    ((qtvs, dicts, _, _), lie_top) <- captureTopConstraints $
+                                      {-# SCC "simplifyInfer" #-}
+                                      simplifyInfer tclvl
                                                  infer_mode
                                                  []    {- No sig vars -}
                                                  [(fresh_it, res_ty)]
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 6383b57c28..381710b938 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -95,9 +95,9 @@ module TcRnTypes(
         CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,
         ctLocTypeOrKind_maybe,
         ctLocDepth, bumpCtLocDepth,
-        setCtLocOrigin, setCtLocEnv, setCtLocSpan,
+        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,
         CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
-        ErrorThing(..), mkErrorThing, errorThingNumArgs_maybe,
+        isVisibleOrigin, toInvisibleOrigin,
         TypeOrKind(..), isTypeLevel, isKindLevel,
         pprCtOrigin, pprCtLoc,
         pushErrCtxt, pushErrCtxtSameOrigin,
@@ -106,7 +106,7 @@ module TcRnTypes(
         termEvidenceAllowed,
 
         CtEvidence(..), TcEvDest(..),
-        mkGivenLoc, mkKindLoc, toKindLoc,
+        mkKindLoc, toKindLoc, mkGivenLoc,
         isWanted, isGiven, isDerived, isGivenOrWDeriv,
         ctEvRole,
 
@@ -183,9 +183,7 @@ import Util
 import PrelNames ( isUnboundName )
 
 import Control.Monad (ap, liftM, msum)
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 import Data.Set      ( Set )
 import qualified Data.Set as S
 
@@ -1083,7 +1081,7 @@ data PromotionErr
                      -- See Note [Don't promote pattern synonyms] in TcEnv
 
   | RecDataConPE     -- Data constructor in a recursive loop
-                     -- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls
+                     -- See Note [Recursion and promoting data constructors] in TcTyClsDecls
   | NoDataKindsTC    -- -XDataKinds not enabled (for a tycon)
   | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)
   | NoTypeInTypeTC   -- -XTypeInType not enabled (for a tycon)
@@ -1617,7 +1615,7 @@ data Ct
        --   * tv not in tvs(rhs)   (occurs check)
        --   * If tv is a TauTv, then rhs has no foralls
        --       (this avoids substituting a forall for the tyvar in other types)
-       --   * typeKind ty `tcEqKind` typeKind tv
+       --   * typeKind ty `tcEqKind` typeKind tv; Note [Ct kind invariant]
        --   * rhs may have at most one top-level cast
        --   * rhs (perhaps under the one cast) is not necessarily function-free,
        --       but it has no top-level function.
@@ -1640,7 +1638,7 @@ data Ct
   | CFunEqCan {  -- F xis ~ fsk
        -- Invariants:
        --   * isTypeFamilyTyCon cc_fun
-       --   * typeKind (F xis) = tyVarKind fsk
+       --   * typeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant]
        --   * always Nominal role
       cc_ev     :: CtEvidence,  -- See Note [Ct/evidence invariant]
       cc_fun    :: TyCon,       -- A type function
@@ -1717,6 +1715,14 @@ built (in TcCanonical).
 In contrast, the type of the evidence *term* (ctev_dest / ctev_evar) in
 the evidence may *not* be fully zonked; we are careful not to look at it
 during constraint solving. See Note [Evidence field of CtEvidence].
+
+Note [Ct kind invariant]
+~~~~~~~~~~~~~~~~~~~~~~~~
+CTyEqCan and CFunEqCan both require that the kind of the lhs matches the kind
+of the rhs. This is necessary because both constraints are used for substitutions
+during solving. If the kinds differed, then the substitution would take a well-kinded
+type to an ill-kinded one.
+
 -}
 
 mkNonCanonical :: CtEvidence -> Ct
@@ -2246,7 +2252,13 @@ getInsolubles = wc_insol
 
 insolublesOnly :: WantedConstraints -> WantedConstraints
 -- Keep only the insolubles
-insolublesOnly wc = wc { wc_simple = emptyBag, wc_impl = emptyBag }
+insolublesOnly (WC { wc_insol = insols, wc_impl = implics })
+  = WC { wc_simple = emptyBag
+       , wc_insol  = insols
+       , wc_impl = mapBag implic_insols_only implics }
+  where
+    implic_insols_only implic
+      = implic { ic_wanted = insolublesOnly (ic_wanted implic) }
 
 dropDerivedWC :: WantedConstraints -> WantedConstraints
 -- See Note [Dropping derived constraints]
@@ -2904,25 +2916,20 @@ The 'CtLoc' gives information about where a constraint came from.
 This is important for decent error message reporting because
 dictionaries don't appear in the original source code.
 type will evolve...
+
 -}
 
 data CtLoc = CtLoc { ctl_origin :: CtOrigin
                    , ctl_env    :: TcLclEnv
                    , ctl_t_or_k :: Maybe TypeOrKind  -- OK if we're not sure
                    , ctl_depth  :: !SubGoalDepth }
+
   -- The TcLclEnv includes particularly
   --    source location:  tcl_loc   :: RealSrcSpan
   --    context:          tcl_ctxt  :: [ErrCtxt]
   --    binder stack:     tcl_bndrs :: TcIdBinderStack
   --    level:            tcl_tclvl :: TcLevel
 
-mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc
-mkGivenLoc tclvl skol_info env
-  = CtLoc { ctl_origin = GivenOrigin skol_info
-          , ctl_env    = env { tcl_tclvl = tclvl }
-          , ctl_t_or_k = Nothing    -- this only matters for error msgs
-          , ctl_depth  = initialSubGoalDepth }
-
 mkKindLoc :: TcType -> TcType   -- original *types* being compared
           -> CtLoc -> CtLoc
 mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)
@@ -2933,6 +2940,13 @@ mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)
 toKindLoc :: CtLoc -> CtLoc
 toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }
 
+mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc
+mkGivenLoc tclvl skol_info env
+  = CtLoc { ctl_origin = GivenOrigin skol_info
+          , ctl_env    = env { tcl_tclvl = tclvl }
+          , ctl_t_or_k = Nothing    -- this only matters for error msgs
+          , ctl_depth  = initialSubGoalDepth }
+
 ctLocEnv :: CtLoc -> TcLclEnv
 ctLocEnv = ctl_env
 
@@ -2960,6 +2974,10 @@ bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDept
 setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc
 setCtLocOrigin ctl orig = ctl { ctl_origin = orig }
 
+updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc
+updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd
+  = ctl { ctl_origin = upd orig }
+
 setCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc
 setCtLocEnv ctl env = ctl { ctl_env = env }
 
@@ -3150,8 +3168,12 @@ data CtOrigin
 
   | TypeEqOrigin { uo_actual   :: TcType
                  , uo_expected :: TcType
-                 , uo_thing    :: Maybe ErrorThing
-                                  -- ^ The thing that has type "actual"
+                 , uo_thing    :: Maybe SDoc
+                       -- ^ The thing that has type "actual"
+                 , uo_visible  :: Bool
+                       -- ^ Is at least one of the three elements above visible?
+                       -- (Errors from the polymorphic subsumption check are considered
+                       -- visible.) Only used for prioritizing error messages.
                  }
 
   | KindEqOrigin
@@ -3227,13 +3249,6 @@ data CtOrigin
         -- Skolem variable arose when we were testing if an instance
         -- is solvable or not.
 
--- | A thing that can be stored for error message generation only.
--- It is stored with a function to zonk and tidy the thing.
-data ErrorThing
-  = forall a. Outputable a => ErrorThing a
-                                         (Maybe Arity)  -- # of args, if known
-                                         (TidyEnv -> a -> TcM (TidyEnv, a))
-
 -- | Flag to see whether we're type-checking terms or kind-checking types
 data TypeOrKind = TypeLevel | KindLevel
   deriving Eq
@@ -3250,20 +3265,24 @@ isKindLevel :: TypeOrKind -> Bool
 isKindLevel TypeLevel = False
 isKindLevel KindLevel = True
 
--- | Make an 'ErrorThing' that doesn't need tidying or zonking
-mkErrorThing :: Outputable a => a -> ErrorThing
-mkErrorThing thing = ErrorThing thing Nothing (\env x -> return (env, x))
-
--- | Retrieve the # of arguments in the error thing, if known
-errorThingNumArgs_maybe :: ErrorThing -> Maybe Arity
-errorThingNumArgs_maybe (ErrorThing _ args _) = args
+-- An origin is visible if the place where the constraint arises is manifest
+-- in user code. Currently, all origins are visible except for invisible
+-- TypeEqOrigins. This is used when choosing which error of
+-- several to report
+isVisibleOrigin :: CtOrigin -> Bool
+isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis
+isVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig
+isVisibleOrigin _                                   = True
+
+-- Converts a visible origin to an invisible one, if possible. Currently,
+-- this works only for TypeEqOrigin
+toInvisibleOrigin :: CtOrigin -> CtOrigin
+toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }
+toInvisibleOrigin orig                   = orig
 
 instance Outputable CtOrigin where
   ppr = pprCtOrigin
 
-instance Outputable ErrorThing where
-  ppr (ErrorThing thing _ _) = ppr thing
-
 ctoHerald :: SDoc
 ctoHerald = text "arising from"
 
@@ -3460,7 +3479,7 @@ pprCtO DefaultOrigin         = text "a 'default' declaration"
 pprCtO DoOrigin              = text "a do statement"
 pprCtO MCompOrigin           = text "a statement in a monad comprehension"
 pprCtO ProcOrigin            = text "a proc expression"
-pprCtO (TypeEqOrigin t1 t2 _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2]
+pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2]
 pprCtO AnnOrigin             = text "an annotation"
 pprCtO HoleOrigin            = text "a use of" <+> quotes (text "_")
 pprCtO ListOrigin            = text "an overloaded list"
@@ -3492,10 +3511,8 @@ instance Monad TcPluginM where
     TcPluginM (\ ev -> do a <- m ev
                           runTcPluginM (k a) ev)
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail TcPluginM where
   fail x   = TcPluginM (const $ fail x)
-#endif
 
 runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a
 runTcPluginM (TcPluginM m) = m
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index b5f6554766..eaa84d6d13 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -160,9 +160,7 @@ import Maybes
 
 import TrieMap
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 import MonadUtils
 import Data.IORef
 import Data.List ( foldl', partition )
@@ -2067,7 +2065,7 @@ solvable from the other. So, we do lookup in the inert set using
 loose types, which omit the kind-check.
 
 We must be careful when using the result of a lookup because it may
-not match the requsted info exactly!
+not match the requested info exactly!
 
 -}
 
@@ -2298,10 +2296,8 @@ instance Monad TcS where
   fail err  = TcS (\_ -> fail err)
   m >>= k   = TcS (\ebs -> unTcS m ebs >>= \r -> unTcS (k r) ebs)
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail TcS where
   fail err  = TcS (\_ -> fail err)
-#endif
 
 instance MonadUnique TcS where
    getUniqueSupplyM = wrapTcS getUniqueSupplyM
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index c898fd96bd..3ff93b6bfa 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -32,7 +32,7 @@ import TcRnMonad
 import TcType
 import TcMType
 import TcValidity ( checkValidType )
-import TcUnify( tcSkolemise, unifyType, noThing )
+import TcUnify( tcSkolemise, unifyType )
 import Inst( topInstantiate )
 import TcEnv( tcLookupId )
 import TcEvidence( HsWrapper, (<.>) )
@@ -722,7 +722,7 @@ tcSpecWrapper ctxt poly_ty spec_ty
   = do { (sk_wrap, inst_wrap)
                <- tcSkolemise ctxt spec_ty $ \ _ spec_tau ->
                   do { (inst_wrap, tau) <- topInstantiate orig poly_ty
-                     ; _ <- unifyType noThing spec_tau tau
+                     ; _ <- unifyType Nothing spec_tau tau
                             -- Deliberately ignore the evidence
                             -- See Note [Handling SPECIALISE pragmas],
                             --   wrinkle (2)
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 42c113610b..1d28eeee4c 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -22,6 +22,7 @@ import Class         ( Class, classKey, classTyCon )
 import DynFlags      ( WarningFlag ( Opt_WarnMonomorphism )
                      , WarnReason ( Reason )
                      , DynFlags( solverIterations ) )
+import Id            ( idType )
 import Inst
 import ListSetOps
 import Maybes
@@ -50,7 +51,9 @@ import ErrUtils      ( emptyMessages )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
-import Data.List     ( partition )
+import Data.Foldable      ( toList )
+import Data.List          ( partition )
+import Data.List.NonEmpty ( NonEmpty(..) )
 
 {-
 *********************************************************************************
@@ -576,14 +579,16 @@ simplifyInfer :: TcLevel               -- Used when generating the constraints
               -> WantedConstraints
               -> TcM ([TcTyVar],    -- Quantify over these type variables
                       [EvVar],      -- ... and these constraints (fully zonked)
-                      TcEvBinds)    -- ... binding these evidence variables
+                      TcEvBinds,    -- ... binding these evidence variables
+                      Bool)         -- True <=> there was an insoluble type error
+                                    --          in these bindings
 simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
   | isEmptyWC wanteds
   = do { gbl_tvs <- tcGetGlobalTyCoVars
        ; dep_vars <- zonkTcTypesAndSplitDepVars (map snd name_taus)
        ; qtkvs <- quantifyTyVars gbl_tvs dep_vars
        ; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs)
-       ; return (qtkvs, [], emptyTcEvBinds) }
+       ; return (qtkvs, [], emptyTcEvBinds, False) }
 
   | otherwise
   = do { traceTc "simplifyInfer {"  $ vcat
@@ -611,33 +616,31 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
        ; wanted_transformed_incl_derivs
             <- setTcLevel rhs_tclvl $
                runTcSWithEvBinds ev_binds_var $
-               do { let loc = mkGivenLoc rhs_tclvl UnkSkol tc_lcl_env
+               do { let loc         = mkGivenLoc rhs_tclvl UnkSkol tc_lcl_env
                         psig_givens = mkGivens loc psig_theta_vars
                   ; _ <- solveSimpleGivens psig_givens
                          -- See Note [Add signature contexts as givens]
                   ; wanteds' <- solveWanteds wanteds
                   ; TcS.zonkWC wanteds' }
 
+
        -- Find quant_pred_candidates, the predicates that
        -- we'll consider quantifying over
        -- NB1: wanted_transformed does not include anything provable from
        --      the psig_theta; it's just the extra bit
        -- NB2: We do not do any defaulting when inferring a type, this can lead
        --      to less polymorphic types, see Note [Default while Inferring]
-
-       ; let wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs
-             quant_pred_candidates   -- Fully zonked
-                 | insolubleWC wanted_transformed_incl_derivs
-                 = []   -- See Note [Quantification with errors]
-                        -- NB: must include derived errors in this test,
-                        --     hence "incl_derivs"
-
-                 | otherwise
-                 = ctsPreds (approximateWC False wanted_transformed)
-
-       -- NB: quant_pred_candidates is already fully zonked
+       ; let definite_error = insolubleWC wanted_transformed_incl_derivs
+                              -- See Note [Quantification with errors]
+                              -- NB: must include derived errors in this test,
+                              --     hence "incl_derivs"
+             wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs
+             quant_pred_candidates
+               | definite_error = []
+               | otherwise      = ctsPreds (approximateWC False wanted_transformed)
 
        -- Decide what type variables and constraints to quantify
+       -- NB: quant_pred_candidates is already fully zonked
        -- NB: bound_theta are constraints we want to quantify over,
        --     /apart from/ the psig_theta, which we always quantify over
        ; (qtvs, bound_theta) <- decideQuantification infer_mode rhs_tclvl
@@ -648,41 +651,58 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
         -- remaining constraints from the RHS.
         -- We must retain the psig_theta_vars, because we've used them in
         -- evidence bindings constructed by solveWanteds earlier
-       ; psig_theta_vars  <- mapM zonkId psig_theta_vars
+       ; psig_theta_vars  <- mapM zonkId       psig_theta_vars
        ; bound_theta_vars <- mapM TcM.newEvVar bound_theta
-       ; let full_theta      = psig_theta      ++ bound_theta
-             full_theta_vars = psig_theta_vars ++ bound_theta_vars
-             skol_info   = InferSkol [ (name, mkSigmaTy [] full_theta ty)
-                                     | (name, ty) <- name_taus ]
-                        -- Don't add the quantified variables here, because
-                        -- they are also bound in ic_skols and we want them
-                        -- to be tidied uniformly
+       ; let full_theta_vars = psig_theta_vars ++ bound_theta_vars
 
-             implic = Implic { ic_tclvl    = rhs_tclvl
-                             , ic_skols    = qtvs
-                             , ic_no_eqs   = False
-                             , ic_given    = full_theta_vars
-                             , ic_wanted   = wanted_transformed
-                             , ic_status   = IC_Unsolved
-                             , ic_binds    = ev_binds_var
-                             , ic_info     = skol_info
-                             , ic_needed   = emptyVarSet
-                             , ic_env      = tc_lcl_env }
-       ; emitImplication implic
+       ; emitResidualImplication rhs_tclvl tc_lcl_env ev_binds_var
+                                 name_taus qtvs full_theta_vars
+                                 wanted_transformed
 
          -- All done!
        ; traceTc "} simplifyInfer/produced residual implication for quantification" $
          vcat [ text "quant_pred_candidates =" <+> ppr quant_pred_candidates
               , text "psig_theta =" <+> ppr psig_theta
               , text "bound_theta =" <+> ppr bound_theta
-              , text "full_theta =" <+> ppr full_theta
+              , text "full_theta =" <+> ppr (map idType full_theta_vars)
               , text "qtvs ="       <+> ppr qtvs
-              , text "implic ="     <+> ppr implic ]
+              , text "definite_error =" <+> ppr definite_error ]
 
-       ; return ( qtvs, full_theta_vars, TcEvBinds ev_binds_var ) }
+       ; return ( qtvs, full_theta_vars, TcEvBinds ev_binds_var, definite_error ) }
          -- NB: full_theta_vars must be fully zonked
 
 
+--------------------
+emitResidualImplication :: TcLevel -> TcLclEnv -> EvBindsVar
+                        -> [(Name, TcTauType)] -> [TcTyVar] -> [EvVar]
+                        -> WantedConstraints -> TcM ()
+emitResidualImplication rhs_tclvl tc_lcl_env ev_binds_var
+                        name_taus qtvs full_theta_vars wanteds
+ | isEmptyWC wanteds
+ = return ()
+ | otherwise
+ = do { traceTc "emitResidualImplication" (ppr implic)
+      ; emitImplication implic }
+ where
+   implic = Implic { ic_tclvl    = rhs_tclvl
+                   , ic_skols    = qtvs
+                   , ic_no_eqs   = False
+                   , ic_given    = full_theta_vars
+                   , ic_wanted   = wanteds
+                   , ic_status   = IC_Unsolved
+                   , ic_binds    = ev_binds_var
+                   , ic_info     = skol_info
+                   , ic_needed   = emptyVarSet
+                   , ic_env      = tc_lcl_env }
+
+   full_theta = map idType full_theta_vars
+   skol_info  = InferSkol [ (name, mkSigmaTy [] full_theta ty)
+                          | (name, ty) <- name_taus ]
+                        -- Don't add the quantified variables here, because
+                        -- they are also bound in ic_skols and we want them
+                        -- to be tidied uniformly
+
+--------------------
 ctsPreds :: Cts -> [PredType]
 ctsPreds cts = [ ctEvPred ev | ct <- bagToList cts
                              , let ev = ctEvidence ct ]
@@ -1092,13 +1112,33 @@ Notice that
 Note [Quantification with errors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we find that the RHS of the definition has some absolutely-insoluble
-constraints, we abandon all attempts to find a context to quantify
-over, and instead make the function fully-polymorphic in whatever
-type we have found.  For two reasons
-  a) Minimise downstream errors
-  b) Avoid spurious errors from this function
-
-But NB that we must include *derived* errors in the check. Example:
+constraints (including especially "variable not in scope"), we
+
+* Abandon all attempts to find a context to quantify over,
+  and instead make the function fully-polymorphic in whatever
+  type we have found
+
+* Return a flag from simplifyInfer, indicating that we found an
+  insoluble constraint.  This flag is used to suppress the ambiguity
+  check for the inferred type, which may well be bogus, and which
+  tends to obscure the real error.  This fix feels a bit clunky,
+  but I failed to come up with anything better.
+
+Reasons:
+    - Avoid downstream errors
+    - Do not perform an ambiguity test on a bogus type, which might well
+      fail spuriously, thereby obfuscating the original insoluble error.
+      Trac #14000 is an example
+
+I tried an alterantive approach: simply failM, after emitting the
+residual implication constraint; the exception will be caught in
+TcBinds.tcPolyBinds, which gives all the binders in the group the type
+(forall a. a).  But that didn't work with -fdefer-type-errors, because
+the recovery from failM emits no code at all, so there is no function
+to run!   But -fdefer-type-errors aspires to produce a runnable program.
+
+NB that we must include *derived* errors in the check for insolubles.
+Example:
     (a::*) ~ Int#
 We get an insoluble derived error *~#, and we don't want to discard
 it before doing the isInsolubleWC test!  (Trac #8262)
@@ -1983,7 +2023,8 @@ floatEqualities skols no_given_eqs
        ; return ( float_eqs
                 , wanteds { wc_simple = remaining_simples } ) }
 
-usefulToFloat :: VarSet -> Ct -> Bool
+usefulToFloat :: VarSet        -- ^ the skolems in the implication
+              -> Ct -> Bool
 usefulToFloat skol_set ct   -- The constraint is un-flattened and de-canonicalised
   = is_meta_var_eq pred &&
     (tyCoVarsOfType pred `disjointVarSet` skol_set)
@@ -1995,6 +2036,7 @@ usefulToFloat skol_set ct   -- The constraint is un-flattened and de-canonicalis
       -- See Note [Which equalities to float]
     is_meta_var_eq pred
       | EqPred NomEq ty1 ty2 <- classifyPredType pred
+      , is_homogeneous ty1 ty2
       = case (tcGetTyVar_maybe ty1, tcGetTyVar_maybe ty2) of
           (Just tv1, _) -> float_tv_eq tv1 ty2
           (_, Just tv2) -> float_tv_eq tv2 ty1
@@ -2006,6 +2048,17 @@ usefulToFloat skol_set ct   -- The constraint is un-flattened and de-canonicalis
       =  isMetaTyVar tv1
       && (not (isSigTyVar tv1) || isTyVarTy ty2)
 
+    is_homogeneous ty1 ty2
+      = not has_heterogeneous_form ||  -- checking the shape is quicker
+                                       -- than looking at kinds
+        typeKind ty1 `tcEqType` typeKind ty2
+
+    has_heterogeneous_form = case ct of
+      CIrredEvCan {}   -> True
+      CNonCanonical {} -> True
+      _                -> False
+
+
 {- Note [Float equalities from under a skolem binding]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Which of the simple equalities can we float out?  Obviously, only
@@ -2035,7 +2088,7 @@ Which equalities should we float?  We want to float ones where there
 is a decent chance that floating outwards will allow unification to
 happen.  In particular:
 
-   Float out equalities of form (alpha ~ ty) or (ty ~ alpha), where
+   Float out homogeneous equalities of form (alpha ~ ty) or (ty ~ alpha), where
 
    * alpha is a meta-tyvar.
 
@@ -2043,6 +2096,15 @@ happen.  In particular:
      case, floating out won't help either, and it may affect grouping
      of error messages.
 
+Why homogeneous (i.e., the kinds of the types are the same)? Because heterogeneous
+equalities have derived kind equalities. See Note [Equalities with incompatible kinds]
+in TcCanonical. If we float out a hetero equality, then it will spit out the
+same derived kind equality again, which might create duplicate error messages.
+Instead, we do float out the kind equality (if it's worth floating out, as
+above). If/when we solve it, we'll be able to rewrite the original hetero equality
+to be homogeneous, and then perhaps make progress / float it out. The duplicate
+error message was spotted in typecheck/should_fail/T7368.
+
 Note [Skolem escape]
 ~~~~~~~~~~~~~~~~~~~~
 You might worry about skolem escape with all this floating.
@@ -2101,7 +2163,8 @@ findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
   = []
   | otherwise
   = [ (tv, map fstOf3 group)
-    | group@((_,_,tv):_) <- unary_groups
+    | group'@((_,_,tv) :| _) <- unary_groups
+    , let group = toList group'
     , defaultable_tyvar tv
     , defaultable_classes (map sndOf3 group) ]
   where
@@ -2109,9 +2172,9 @@ findDefaultableGroups (default_tys, (ovl_strings, extended_defaults)) wanteds
     (unaries, non_unaries) = partitionWith find_unary (bagToList simples)
     unary_groups           = equivClasses cmp_tv unaries
 
-    unary_groups :: [[(Ct, Class, TcTyVar)]]  -- (C tv) constraints
-    unaries      ::  [(Ct, Class, TcTyVar)]   -- (C tv) constraints
-    non_unaries  :: [Ct]                      -- and *other* constraints
+    unary_groups :: [NonEmpty (Ct, Class, TcTyVar)] -- (C tv) constraints
+    unaries      :: [(Ct, Class, TcTyVar)]          -- (C tv) constraints
+    non_unaries  :: [Ct]                            -- and *other* constraints
 
         -- Finds unary type-class constraints
         -- But take account of polykinded classes like Typeable,
@@ -2177,10 +2240,8 @@ disambigGroup (default_ty:default_tys) group@(the_tv, wanteds)
     try_group
       | Just subst <- mb_subst
       = do { lcl_env <- TcS.getLclEnv
-           ; let loc = CtLoc { ctl_origin = GivenOrigin UnkSkol
-                             , ctl_env    = lcl_env
-                             , ctl_t_or_k = Nothing
-                             , ctl_depth  = initialSubGoalDepth }
+           ; tc_lvl <- TcS.getTcLevel
+           ; let loc = mkGivenLoc tc_lvl UnkSkol lcl_env
            ; wanted_evs <- mapM (newWantedEvVarNC loc . substTy subst . ctPred)
                                 wanteds
            ; fmap isEmptyWC $
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index e6d5097e29..c0c270cc81 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -135,8 +135,8 @@ import GHC.Exts         ( unsafeCoerce# )
 ************************************************************************
 -}
 
-tcTypedBracket   :: HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
-tcUntypedBracket :: HsBracket GhcRn -> [PendingRnSplice] -> ExpRhoType
+tcTypedBracket   :: HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcUntypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> [PendingRnSplice] -> ExpRhoType
                  -> TcM (HsExpr GhcTcId)
 tcSpliceExpr     :: HsSplice GhcRn  -> ExpRhoType -> TcM (HsExpr GhcTcId)
         -- None of these functions add constraints to the LIE
@@ -157,7 +157,7 @@ runAnnotation     :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation
 
 -- See Note [How brackets and nested splices are handled]
 -- tcTypedBracket :: HsBracket Name -> TcRhoType -> TcM (HsExpr TcId)
-tcTypedBracket brack@(TExpBr expr) res_ty
+tcTypedBracket rn_expr brack@(TExpBr expr) res_ty
   = addErrCtxt (quotationCtxtDoc brack) $
     do { cur_stage <- getStage
        ; ps_ref <- newMutVar []
@@ -176,20 +176,21 @@ tcTypedBracket brack@(TExpBr expr) res_ty
        ; ps' <- readMutVar ps_ref
        ; texpco <- tcLookupId unsafeTExpCoerceName
        ; tcWrapResultO (Shouldn'tHappenOrigin "TExpBr")
+                       rn_expr
                        (unLoc (mkHsApp (nlHsTyApp texpco [expr_ty])
                                               (noLoc (HsTcBracketOut brack ps'))))
                        meta_ty res_ty }
-tcTypedBracket other_brack _
+tcTypedBracket _ other_brack _
   = pprPanic "tcTypedBracket" (ppr other_brack)
 
 -- tcUntypedBracket :: HsBracket Name -> [PendingRnSplice] -> ExpRhoType -> TcM (HsExpr TcId)
-tcUntypedBracket brack ps res_ty
+tcUntypedBracket rn_expr brack ps res_ty
   = do { traceTc "tc_bracket untyped" (ppr brack $$ ppr ps)
        ; ps' <- mapM tcPendingSplice ps
        ; meta_ty <- tcBrackTy brack
        ; traceTc "tc_bracket done untyped" (ppr meta_ty)
        ; tcWrapResultO (Shouldn'tHappenOrigin "untyped bracket")
-                       (HsTcBracketOut brack ps') meta_ty res_ty }
+                       rn_expr (HsTcBracketOut brack ps') meta_ty res_ty }
 
 ---------------
 tcBrackTy :: HsBracket GhcRn -> TcM TcType
@@ -868,7 +869,6 @@ instance TH.Quasi TcM where
         -- the recovery action is chosen.  Otherwise
         -- we'll only fail higher up.
   qRecover recover main = tryTcDiscardingErrs recover main
-  qRunIO io = liftIO io
 
   qAddDependentFile fp = do
     ref <- fmap tcg_dependent_files getGblEnv
@@ -1137,7 +1137,11 @@ reifyInstances th_nm th_tys
         ; let tv_rdrs = freeKiTyVarsAllVars free_vars
           -- Rename  to HsType Name
         ; ((tv_names, rn_ty), _fvs)
-            <- bindLRdrNames tv_rdrs $ \ tv_names ->
+            <- checkNoErrs $ -- If there are out-of-scope Names here, then we
+                             -- must error before proceeding to typecheck the
+                             -- renamed type, as that will result in GHC
+                             -- internal errors (#13837).
+               bindLRdrNames tv_rdrs $ \ tv_names ->
                do { (rn_ty, fvs) <- rnLHsType doc rdr_ty
                   ; return ((tv_names, rn_ty), fvs) }
         ; (_tvs, ty)
diff --git a/compiler/typecheck/TcSplice.hs-boot b/compiler/typecheck/TcSplice.hs-boot
index 2aa51c8bcd..03b2c31315 100644
--- a/compiler/typecheck/TcSplice.hs-boot
+++ b/compiler/typecheck/TcSplice.hs-boot
@@ -17,11 +17,13 @@ tcSpliceExpr :: HsSplice GhcRn
              -> ExpRhoType
              -> TcM (HsExpr GhcTcId)
 
-tcUntypedBracket :: HsBracket GhcRn
+tcUntypedBracket :: HsExpr GhcRn
+                 -> HsBracket GhcRn
                  -> [PendingRnSplice]
                  -> ExpRhoType
                  -> TcM (HsExpr GhcTcId)
-tcTypedBracket :: HsBracket GhcRn
+tcTypedBracket :: HsExpr GhcRn
+               -> HsBracket GhcRn
                -> ExpRhoType
                -> TcM (HsExpr GhcTcId)
 
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index aafea76335..4488da7305 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -33,7 +33,8 @@ import TcTyDecls
 import TcClassDcl
 import {-# SOURCE #-} TcInstDcls( tcInstDecls1 )
 import TcDeriv (DerivInfo)
-import TcUnify
+import TcEvidence  ( tcCoercionKind, isEmptyTcEvBinds )
+import TcUnify     ( checkConstraints )
 import TcHsType
 import TcMType
 import TysWiredIn ( unitTy )
@@ -61,6 +62,7 @@ import Outputable
 import Maybes
 import Unify
 import Util
+import Pair
 import SrcLoc
 import ListSetOps
 import DynFlags
@@ -70,6 +72,7 @@ import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.List
+import Data.List.NonEmpty ( NonEmpty(..) )
 
 {-
 ************************************************************************
@@ -203,7 +206,7 @@ tcTyClDecls tyclds role_annots
 
                  -- Populate environment with knot-tied ATyCon for TyCons
                  -- NB: if the decls mention any ill-staged data cons
-                 -- (see Note [Recusion and promoting data constructors])
+                 -- (see Note [Recursion and promoting data constructors])
                  -- we will have failed already in kcTyClGroup, so no worries here
            ; tcExtendRecEnv (zipRecTyClss tc_tycons rec_tyclss) $
 
@@ -424,7 +427,7 @@ mkPromotionErrorEnv :: [LTyClDecl GhcRn] -> TcTypeEnv
 -- Maps each tycon/datacon to a suitable promotion error
 --    tc :-> APromotionErr TyConPE
 --    dc :-> APromotionErr RecDataConPE
---    See Note [ARecDataCon: Recursion and promoting data constructors]
+--    See Note [Recursion and promoting data constructors]
 
 mkPromotionErrorEnv decls
   = foldr (plusNameEnv . mk_prom_err_env . unLoc)
@@ -454,7 +457,7 @@ getInitialKinds :: [LTyClDecl GhcRn] -> TcM (NameEnv TcTyThing)
 -- and each datacon to a suitable promotion error
 --    tc :-> ATcTyCon (tc:initial_kind)
 --    dc :-> APromotionErr RecDataConPE
---    See Note [ARecDataCon: Recursion and promoting data constructors]
+--    See Note [Recursion and promoting data constructors]
 
 getInitialKinds decls
   = tcExtendKindEnv promotion_err_env $
@@ -826,7 +829,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
   = tcTyClTyVars tc_name $ \ binders res_kind -> do
   { traceTc "data family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; (extra_binders, real_res_kind) <- tcDataKindSig res_kind
+  ; (extra_binders, real_res_kind) <- tcDataKindSig False res_kind
   ; tc_rep_name <- newTyConRepName tc_name
   ; let tycon = mkFamilyTyCon tc_name (binders `chkAppend` extra_binders)
                               real_res_kind
@@ -870,7 +873,11 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
            Just eqns -> do {
 
          -- Process the equations, creating CoAxBranches
-       ; let fam_tc_shape = (tc_name, length $ hsQTvExplicit tvs, binders, res_kind)
+       ; let fam_tc_shape = FamTyConShape { fs_name     = tc_name
+                                          , fs_arity    = length $ hsQTvExplicit tvs
+                                          , fs_flavor   = TypeFam
+                                          , fs_binders  = binders
+                                          , fs_res_kind = res_kind }
 
        ; branches <- mapM (tcTyFamInstEqn fam_tc_shape Nothing) eqns
          -- Do not attempt to drop equations dominated by earlier
@@ -970,7 +977,7 @@ tcDataDefn roles_info
          (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                      , dd_ctxt = ctxt, dd_kindSig = mb_ksig
                      , dd_cons = cons })
- =  do { (extra_bndrs, real_res_kind) <- tcDataKindSig res_kind
+ =  do { (extra_bndrs, real_res_kind) <- tcDataKindSig True res_kind
        ; let final_bndrs  = tycon_binders `chkAppend` extra_bndrs
              roles        = roles_info tc_name
 
@@ -1082,15 +1089,16 @@ tcDefaultAssocDecl _ (d1:_:_)
   = failWithTc (text "More than one default declaration for"
                 <+> ppr (tfe_tycon (unLoc d1)))
 
-tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name
-                                           , tfe_pats = hs_tvs
+tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = lname@(L _ tc_name)
+                                           , tfe_pats = hs_tvs, tfe_fixity = fixity
                                            , tfe_rhs = rhs })]
   | HsQTvs { hsq_implicit = imp_vars, hsq_explicit = exp_vars } <- hs_tvs
   = -- See Note [Type-checking default assoc decls]
     setSrcSpan loc $
     tcAddFamInstCtxt (text "default type instance") tc_name $
     do { traceTc "tcDefaultAssocDecl" (ppr tc_name)
-       ; let shape@(fam_tc_name, fam_arity, _, _) = famTyConShape fam_tc
+       ; let shape@(FamTyConShape { fs_name = fam_tc_name
+                                  , fs_arity = fam_arity }) = famTyConShape fam_tc
 
        -- Kind of family check
        ; ASSERT( fam_tc_name == tc_name )
@@ -1104,12 +1112,20 @@ tcDefaultAssocDecl fam_tc [L loc (TyFamEqn { tfe_tycon = L _ tc_name
        ; let pats = HsIB { hsib_vars = imp_vars ++ map hsLTyVarName exp_vars
                          , hsib_body = map hsLTyVarBndrToType exp_vars
                          , hsib_closed = False } -- this field is ignored, anyway
+             pp_lhs = pprFamInstLHS lname pats fixity [] Nothing
+
           -- NB: Use tcFamTyPats, not tcTyClTyVars. The latter expects to get
           -- the LHsQTyVars used for declaring a tycon, but the names here
           -- are different.
+
+          -- You might think we should pass in some ClsInstInfo, as we're looking
+          -- at an associated type. But this would be wrong, because an associated
+          -- type default LHS can mention *different* type variables than the
+          -- enclosing class. So it's treated more as a freestanding beast.
        ; (pats', rhs_ty)
            <- tcFamTyPats shape Nothing pats
-              (discardResult . tcCheckLHsType rhs) $ \tvs pats rhs_kind ->
+              (kcTyFamEqnRhs Nothing pp_lhs rhs) $
+              \tvs pats rhs_kind ->
               do { rhs_ty <- solveEqualities $
                              tcCheckLHsType rhs rhs_kind
 
@@ -1150,29 +1166,54 @@ proper tcMatchTys here.)  -}
 
 -------------------------
 kcTyFamInstEqn :: FamTyConShape -> LTyFamInstEqn GhcRn -> TcM ()
-kcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_)
-    (L loc (TyFamEqn { tfe_tycon = L _ eqn_tc_name
-                     , tfe_pats  = pats
-                     , tfe_rhs   = hs_ty }))
+kcTyFamInstEqn fam_tc_shape@(FamTyConShape { fs_name = fam_tc_name })
+    (L loc (TyFamEqn { tfe_tycon  = lname@(L _ eqn_tc_name)
+                     , tfe_pats   = pats
+                     , tfe_fixity = fixity
+                     , tfe_rhs    = hs_ty }))
   = setSrcSpan loc $
     do { checkTc (fam_tc_name == eqn_tc_name)
                  (wrongTyFamName fam_tc_name eqn_tc_name)
        ; discardResult $
          tc_fam_ty_pats fam_tc_shape Nothing -- not an associated type
-                        pats (discardResult . (tcCheckLHsType hs_ty)) }
+                        pats (kcTyFamEqnRhs Nothing pp_lhs hs_ty) }
+  where
+    pp_lhs = pprFamInstLHS lname pats fixity [] Nothing
+
+-- Infer the kind of the type on the RHS of a type family eqn. Then use
+-- this kind to check the kind of the LHS of the equation. This is useful
+-- as the callback to tc_fam_ty_pats and the kind-checker to
+-- tcFamTyPats.
+kcTyFamEqnRhs :: Maybe ClsInstInfo
+              -> SDoc                 -- ^ Eqn LHS (for errors only)
+              -> LHsType GhcRn        -- ^ Eqn RHS
+              -> TcKind               -- ^ Inferred kind of left-hand side
+              -> TcM ([TcType], TcKind)  -- ^ New pats, inst'ed kind of left-hand side
+kcTyFamEqnRhs mb_clsinfo pp_lhs_ty rhs_hs_ty lhs_ki
+  = do { -- It's still possible the lhs_ki has some foralls. Instantiate these away.
+         (_lhs_ty', new_pats, insted_lhs_ki)
+           <- instantiateTyUntilN mb_kind_env 0 bogus_ty lhs_ki
+       ; _ <- tcCheckLHsType rhs_hs_ty insted_lhs_ki
+
+       ; return (new_pats, insted_lhs_ki) }
+  where
+    mb_kind_env = thdOf3 <$> mb_clsinfo
+
+    bogus_ty = pprPanic "kcTyFamEqnRhs" (pp_lhs_ty $$ ppr rhs_hs_ty)
 
 tcTyFamInstEqn :: FamTyConShape -> Maybe ClsInstInfo -> LTyFamInstEqn GhcRn
                -> TcM CoAxBranch
 -- Needs to be here, not in TcInstDcls, because closed families
 -- (typechecked here) have TyFamInstEqns
-tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo
-    (L loc (TyFamEqn { tfe_tycon = L _ eqn_tc_name
-                     , tfe_pats  = pats
-                     , tfe_rhs   = hs_ty }))
+tcTyFamInstEqn fam_tc_shape@(FamTyConShape { fs_name = fam_tc_name }) mb_clsinfo
+    (L loc (TyFamEqn { tfe_tycon  = lname@(L _ eqn_tc_name)
+                     , tfe_pats   = pats
+                     , tfe_fixity = fixity
+                     , tfe_rhs    = hs_ty }))
   = ASSERT( fam_tc_name == eqn_tc_name )
     setSrcSpan loc $
     tcFamTyPats fam_tc_shape mb_clsinfo pats
-                (discardResult . (tcCheckLHsType hs_ty)) $
+                (kcTyFamEqnRhs mb_clsinfo pp_lhs hs_ty) $
                     \tvs pats res_kind ->
     do { rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
 
@@ -1184,26 +1225,68 @@ tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo
        ; return (mkCoAxBranch tvs' [] pats' rhs_ty'
                               (map (const Nominal) tvs')
                               loc) }
-
-kcDataDefn :: Name                -- ^ the family name, for error msgs only
-           -> HsTyPats GhcRn      -- ^ the patterns, for error msgs only
-           -> HsDataDefn GhcRn    -- ^ the RHS
-           -> TcKind              -- ^ the expected kind
-           -> TcM ()
+  where
+    pp_lhs = pprFamInstLHS lname pats fixity [] Nothing
+
+kcDataDefn :: Maybe (VarEnv Kind) -- ^ Possibly, instantiations for vars
+                                  -- (associated types only)
+           -> DataFamInstDecl GhcRn
+           -> TcKind              -- ^ the kind of the tycon applied to pats
+           -> TcM ([TcType], TcKind)
+             -- ^ the kind signature might force instantiation
+             -- of the tycon; this returns any extra args and the inst'ed kind
+             -- See Note [Instantiating a family tycon]
 -- Used for 'data instance' only
 -- Ordinary 'data' is handled by kcTyClDec
-kcDataDefn fam_name (HsIB { hsib_body = pats })
-           (HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_kindSig = mb_kind }) res_k
+kcDataDefn mb_kind_env
+           (DataFamInstDecl
+             { dfid_tycon  = fam_name
+             , dfid_pats   = pats
+             , dfid_fixity = fixity
+             , dfid_defn   = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_kindSig = mb_kind } })
+           res_k
   = do  { _ <- tcHsContext ctxt
         ; checkNoErrs $ mapM_ (wrapLocM kcConDecl) cons
           -- See Note [Failing early in kcDataDefn]
-        ; discardResult $
-          case mb_kind of
-            Nothing -> unifyKind (Just hs_ty_pats) res_k liftedTypeKind
-            Just k  -> do { k' <- tcLHsKindSig k
-                          ; unifyKind (Just hs_ty_pats) res_k k' } }
+        ; exp_res_kind <- case mb_kind of
+            Nothing -> return liftedTypeKind
+            Just k  -> tcLHsKindSig k
+
+          -- The expected type might have a forall at the type. Normally, we
+          -- can't skolemise in kinds because we don't have type-level lambda.
+          -- But here, we're at the top-level of an instance declaration, so
+          -- we actually have a place to put the regeneralised variables.
+          -- Thus: skolemise away. cf. Inst.deeplySkolemise and TcUnify.tcSkolemise
+          -- Examples in indexed-types/should_compile/T12369
+        ; let (tvs_to_skolemise, inner_res_kind) = tcSplitForAllTys exp_res_kind
+
+        ; (skol_subst, tvs') <- tcInstSkolTyVars tvs_to_skolemise
+            -- we don't need to do anything substantive with the tvs' because the
+            -- quantifyTyVars in tcFamTyPats will catch them.
+
+        ; let inner_res_kind' = substTyAddInScope skol_subst inner_res_kind
+              tv_prs          = zip (map tyVarName tvs_to_skolemise) tvs'
+              skol_info       = SigSkol InstDeclCtxt exp_res_kind tv_prs
+
+        ; (ev_binds, (_, new_args, co))
+            <- solveEqualities $
+               checkConstraints skol_info tvs' [] $
+               checkExpectedKindX mb_kind_env pp_fam_app
+                                  bogus_ty res_k inner_res_kind'
+
+        ; let Pair lhs_ki rhs_ki = tcCoercionKind co
+
+        ; when debugIsOn $
+          do { (_, ev_binds) <- zonkTcEvBinds emptyZonkEnv ev_binds
+             ; MASSERT( isEmptyTcEvBinds ev_binds )
+             ; lhs_ki <- zonkTcType lhs_ki
+             ; rhs_ki <- zonkTcType rhs_ki
+             ; MASSERT( lhs_ki `tcEqType` rhs_ki ) }
+
+        ; return (new_args, lhs_ki) }
   where
-    hs_ty_pats = mkHsAppTys (noLoc $ HsTyVar NotPromoted (noLoc fam_name)) pats
+    bogus_ty   = pprPanic "kcDataDefn" (ppr fam_name <+> ppr pats)
+    pp_fam_app = pprFamInstLHS fam_name pats fixity (unLoc ctxt) mb_kind
 
 {-
 Kind check type patterns and kind annotate the embedded type variables.
@@ -1231,6 +1314,28 @@ The type FamTyConShape gives just enough information to do the job.
 
 See also Note [tc_fam_ty_pats vs tcFamTyPats]
 
+Note [Instantiating a family tycon]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's possible that kind-checking the result of a family tycon applied to
+its patterns will instantiate the tycon further. For example, we might
+have
+
+  type family F :: k where
+    F = Int
+    F = Maybe
+
+After checking (F :: forall k. k) (with no visible patterns), we still need
+to instantiate the k. With data family instances, this problem can be even
+more intricate, due to Note [Arity of data families] in FamInstEnv. See
+indexed-types/should_compile/T12369 for an example.
+
+So, the kind-checker must return both the new args (that is, Type
+(Type -> Type) for the equations above) and the instantiated kind.
+
+Because we don't need this information in the kind-checking phase of
+checking closed type families, we don't require these extra pieces of
+information in tc_fam_ty_pats. See also Note [tc_fam_ty_pats vs tcFamTyPats].
+
 Note [Failing early in kcDataDefn]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We need to use checkNoErrs when calling kcConDecl. This is because kcConDecl
@@ -1245,22 +1350,31 @@ two bad things could happen:
 -}
 
 -----------------
-type FamTyConShape = (Name, Arity, [TyConBinder], Kind)
+data TypeOrDataFamily = TypeFam | DataFam
+data FamTyConShape = FamTyConShape { fs_name     :: Name
+                                   , fs_arity    :: Arity -- the visible args
+                                   , fs_flavor   :: TypeOrDataFamily
+                                   , fs_binders  :: [TyConBinder]
+                                   , fs_res_kind :: Kind }
   -- See Note [Type-checking type patterns]
 
 famTyConShape :: TyCon -> FamTyConShape
 famTyConShape fam_tc
-  = ( tyConName fam_tc
-    , length $ filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
-    , tyConBinders fam_tc
-    , tyConResKind fam_tc )
+  = FamTyConShape { fs_name     = tyConName fam_tc
+                  , fs_arity    = length $ filterOutInvisibleTyVars fam_tc (tyConTyVars fam_tc)
+                  , fs_flavor   = flav
+                  , fs_binders  = tyConBinders fam_tc
+                  , fs_res_kind = tyConResKind fam_tc }
+  where
+    flav
+      | isTypeFamilyTyCon fam_tc = TypeFam
+      | otherwise                = DataFam
 
 tc_fam_ty_pats :: FamTyConShape
                -> Maybe ClsInstInfo
                -> HsTyPats GhcRn      -- Patterns
-               -> (TcKind -> TcM ())  -- Kind checker for RHS
-                                      -- result is ignored
-               -> TcM ([Type], Kind)
+               -> (TcKind -> TcM r)   -- Kind checker for RHS
+               -> TcM ([Type], r)     -- Returns the type-checked patterns
 -- Check the type patterns of a type or data family instance
 --     type instance F <pat1> <pat2> = <type>
 -- The 'tyvars' are the free type variables of pats
@@ -1272,43 +1386,59 @@ tc_fam_ty_pats :: FamTyConShape
 -- In that case, the type variable 'a' will *already be in scope*
 -- (and, if C is poly-kinded, so will its kind parameter).
 
-tc_fam_ty_pats (name, _, binders, res_kind) mb_clsinfo
-               (HsIB { hsib_body = arg_pats, hsib_vars = tv_names })
+tc_fam_ty_pats (FamTyConShape { fs_name = name, fs_arity = arity
+                              , fs_flavor = flav, fs_binders = binders
+                              , fs_res_kind = res_kind })
+               mb_clsinfo (HsIB { hsib_body = arg_pats, hsib_vars = tv_names })
                kind_checker
-  = do { -- Kind-check and quantify
+  = do { -- First, check the arity.
+         -- If we wait until validity checking, we'll get kind
+         -- errors below when an arity error will be much easier to
+         -- understand.
+         let should_check_arity
+               | TypeFam <- flav = True
+                  -- why not check data families? See [Arity of data families] in FamInstEnv
+               | otherwise       = False
+
+       ; when should_check_arity $
+         checkTc (arg_pats `lengthIs` arity) $
+         wrongNumberOfParmsErr arity
+                      -- report only explicit arguments
+
+         -- Kind-check and quantify
          -- See Note [Quantifying over family patterns]
-         (_, (insted_res_kind, typats)) <- tcImplicitTKBndrs tv_names $
-         do { (insting_subst, _leftover_binders, args, leftovers, n)
-                <- tcInferArgs name binders (thdOf3 <$> mb_clsinfo) arg_pats
-            ; case leftovers of
-                hs_ty:_ -> addErrTc $ too_many_args hs_ty n
-                _       -> return ()
-              -- don't worry about leftover_binders; TcValidity catches them
-
-            ; let insted_res_kind = substTyUnchecked insting_subst res_kind
-            ; kind_checker insted_res_kind
-            ; return ((insted_res_kind, args), emptyVarSet) }
-
-       ; return (typats, insted_res_kind) }
-  where
-    too_many_args hs_ty n
-      = hang (text "Too many parameters to" <+> ppr name <> colon)
-           2 (vcat [ ppr hs_ty <+> text "is unexpected;"
-                   , text (if n == 1 then "expected" else "expected only") <+>
-                     speakNOf (n-1) (text "parameter") ])
+       ; (_, result) <- tcImplicitTKBndrs tv_names $
+         do { let loc          = nameSrcSpan name
+                  lhs_fun      = L loc (HsTyVar NotPromoted (L loc name))
+                  bogus_fun_ty = pprPanic "tc_fam_ty_pats" (ppr name $$ ppr arg_pats)
+                  fun_kind     = mkTyConKind binders res_kind
+                  mb_kind_env  = thdOf3 <$> mb_clsinfo
+
+            ; (_, args, res_kind_out)
+                <- tcInferApps typeLevelMode mb_kind_env
+                               lhs_fun bogus_fun_ty fun_kind arg_pats
+
+            ; stuff <- kind_checker res_kind_out
+
+            ; return ((args, stuff), emptyVarSet) }
+
+       ; return result }
 
 -- See Note [tc_fam_ty_pats vs tcFamTyPats]
 tcFamTyPats :: FamTyConShape
             -> Maybe ClsInstInfo
             -> HsTyPats GhcRn        -- patterns
-            -> (TcKind -> TcM ())    -- kind-checker for RHS
+            -> (TcKind -> TcM ([TcType], TcKind))
+                -- kind-checker for RHS
+                -- See Note [Instantiating a family tycon]
             -> (   [TcTyVar]         -- Kind and type variables
                 -> [TcType]          -- Kind and type arguments
                 -> TcKind
                 -> TcM a)            -- NB: You can use solveEqualities here.
             -> TcM a
-tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside
-  = do { (typats, res_kind)
+tcFamTyPats fam_shape@(FamTyConShape { fs_name = name }) mb_clsinfo pats
+            kind_checker thing_inside
+  = do { (typats, (more_typats, res_kind))
             <- solveEqualities $  -- See Note [Constraints in patterns]
                tc_fam_ty_pats fam_shape mb_clsinfo pats kind_checker
 
@@ -1333,7 +1463,8 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside
             -- them into skolems, so that we don't subsequently
             -- replace a meta kind var with (Any *)
             -- Very like kindGeneralize
-       ; vars  <- zonkTcTypesAndSplitDepVars typats
+       ; let all_pats = typats `chkAppend` more_typats
+       ; vars  <- zonkTcTypesAndSplitDepVars all_pats
        ; qtkvs <- quantifyTyVars emptyVarSet vars
 
        ; MASSERT( isEmptyVarSet $ coVarsOfTypes typats )
@@ -1341,14 +1472,14 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside
            -- above would fail. TODO (RAE): Update once the solveEqualities
            -- bit is cleverer.
 
-       ; traceTc "tcFamTyPats" (ppr name $$ ppr typats $$ ppr qtkvs)
+       ; traceTc "tcFamTyPats" (ppr name $$ ppr all_pats $$ ppr qtkvs)
             -- Don't print out too much, as we might be in the knot
 
        ; tcExtendTyVarEnv qtkvs $
             -- Extend envt with TcTyVars not TyVars, because the
             -- kind checking etc done by thing_inside does not expect
             -- to encounter TyVars; it expects TcTyVars
-         thing_inside qtkvs typats res_kind }
+         thing_inside qtkvs all_pats res_kind }
 
 {-
 Note [Constraints in patterns]
@@ -1564,7 +1695,7 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
 
              ; buildDataCon fam_envs name is_infix rep_nm
                             stricts Nothing field_lbls
-                            (mkDataConUnivTyVarBinders tmpl_bndrs)
+                            (tyConTyVarBinders tmpl_bndrs)
                             ex_tvs
                             [{- no eq_preds -}] ctxt arg_tys
                             res_tmpl rep_tycon
@@ -2238,7 +2369,7 @@ checkValidTyCon tc
     -- result type against other candidates' types BOTH WAYS ROUND.
     -- If they magically agrees, take the substitution and
     -- apply them to the latter ones, and see if they match perfectly.
-    check_fields ((label, con1) : other_fields)
+    check_fields ((label, con1) :| other_fields)
         -- These fields all have the same name, but are from
         -- different constructors in the data type
         = recoverM (return ()) $ mapM_ checkOne other_fields
@@ -2256,7 +2387,6 @@ checkValidTyCon tc
             where
                 (_, _, _, res2) = dataConSig con2
                 fty2 = dataConFieldType con2 lbl
-    check_fields [] = panic "checkValidTyCon/check_fields []"
 
 checkFieldCompat :: FieldLabelString -> DataCon -> DataCon
                  -> Type -> Type -> Type -> Type -> TcM ()
@@ -2528,9 +2658,10 @@ checkValidClass cls
              -- Check that any default declarations for associated types are valid
            ; whenIsJust m_dflt_rhs $ \ (rhs, loc) ->
              checkValidTyFamEqn mb_cls fam_tc
-                                fam_tvs [] (mkTyVarTys fam_tvs) rhs loc }
+                                fam_tvs [] (mkTyVarTys fam_tvs) rhs pp_lhs loc }
         where
           fam_tvs = tyConTyVars fam_tc
+          pp_lhs  = ppr (mkTyConApp fam_tc (mkTyVarTys fam_tvs))
 
     check_dm :: UserTypeCtxt -> Id -> PredType -> Type -> DefMethInfo -> TcM ()
     -- Check validity of the /top-level/ generic-default type
@@ -2863,6 +2994,10 @@ checkValidRoles tc
         ex_roles   = mkVarEnv (map (, Nominal) ex_tvs)
         role_env   = univ_roles `plusVarEnv` ex_roles
 
+    check_ty_roles env role ty
+      | Just ty' <- coreView ty -- #14101
+      = check_ty_roles env role ty'
+
     check_ty_roles env role (TyVarTy tv)
       = case lookupVarEnv env tv of
           Just role' -> unless (role' `ltRole` role || role' == role) $
diff --git a/compiler/typecheck/TcTyDecls.hs b/compiler/typecheck/TcTyDecls.hs
index 68e15fbd48..e55b8e8503 100644
--- a/compiler/typecheck/TcTyDecls.hs
+++ b/compiler/typecheck/TcTyDecls.hs
@@ -580,6 +580,8 @@ irDataCon datacon
 irType :: VarSet -> Type -> RoleM ()
 irType = go
   where
+    go lcls ty                 | Just ty' <- coreView ty -- #14101
+                               = go lcls ty'
     go lcls (TyVarTy tv)       = unless (tv `elemVarSet` lcls) $
                                  updateRole Representational tv
     go lcls (AppTy t1 t2)      = go lcls t1 >> markNominal lcls t2
@@ -771,10 +773,18 @@ mkDefaultMethodIds tycons
 mkDefaultMethodType :: Class -> Id -> DefMethSpec Type -> Type
 -- Returns the top-level type of the default method
 mkDefaultMethodType _ sel_id VanillaDM        = idType sel_id
-mkDefaultMethodType cls _   (GenericDM dm_ty) = mkSpecSigmaTy cls_tvs [pred] dm_ty
+mkDefaultMethodType cls _   (GenericDM dm_ty) = mkSigmaTy tv_bndrs [pred] dm_ty
    where
-     cls_tvs = classTyVars cls
-     pred    = mkClassPred cls (mkTyVarTys cls_tvs)
+     pred      = mkClassPred cls (mkTyVarTys (binderVars cls_bndrs))
+     cls_bndrs = tyConBinders (classTyCon cls)
+     tv_bndrs  = tyConTyVarBinders cls_bndrs
+     -- NB: the Class doesn't have TyConBinders; we reach into its
+     --     TyCon to get those.  We /do/ need the TyConBinders because
+     --     we need the correct visiblity: these default methods are
+     --     used in code generated by the the fill-in for missing
+     --     methods in instances (TcInstDcls.mkDefMethBind), and
+     --     then typechecked.  So we need the right visibilty info
+     --     (Trac #13998)
 
 {-
 ************************************************************************
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index e12b70b6d1..3b97555158 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -58,7 +58,7 @@ module TcType (
   -- These are important because they do not look through newtypes
   getTyVar,
   tcSplitForAllTy_maybe,
-  tcSplitForAllTys, tcSplitPiTys, tcSplitForAllTyVarBndrs,
+  tcSplitForAllTys, tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllTyVarBndrs,
   tcSplitPhiTy, tcSplitPredFunTy_maybe,
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN,
   tcSplitFunTysN,
@@ -66,7 +66,8 @@ module TcType (
   tcRepSplitTyConApp_maybe, tcRepSplitTyConApp_maybe',
   tcTyConAppTyCon, tcTyConAppTyCon_maybe, tcTyConAppArgs,
   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, tcRepSplitAppTy_maybe,
-  tcGetTyVar_maybe, tcGetTyVar, nextRole,
+  tcRepGetNumAppTys,
+  tcGetCastedTyVar_maybe, tcGetTyVar_maybe, tcGetTyVar, nextRole,
   tcSplitSigmaTy, tcSplitNestedSigmaTys, tcDeepSplitSigmaTy_maybe,
 
   ---------------------------------
@@ -186,7 +187,11 @@ module TcType (
   pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred,
   pprTvBndr, pprTvBndrs,
 
-  TypeSize, sizeType, sizeTypes, toposortTyVars
+  TypeSize, sizeType, sizeTypes, toposortTyVars,
+
+  ---------------------------------
+  -- argument visibility
+  tcTyConVisibilities, isNextTyConArgVisible, isNextArgVisible
 
   ) where
 
@@ -219,6 +224,7 @@ import BasicTypes
 import Util
 import Bag
 import Maybes
+import ListSetOps ( getNth )
 import Outputable
 import FastString
 import ErrUtils( Validity(..), MsgDoc, isValid )
@@ -1357,6 +1363,10 @@ variables.  It's up to you to make sure this doesn't matter.
 tcSplitPiTys :: Type -> ([TyBinder], Type)
 tcSplitPiTys = splitPiTys
 
+-- | Splits a type into a TyBinder and a body, if possible. Panics otherwise
+tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
+tcSplitPiTy_maybe = splitPiTy_maybe
+
 tcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type)
 tcSplitForAllTy_maybe ty | Just ty' <- tcView ty = tcSplitForAllTy_maybe ty'
 tcSplitForAllTy_maybe (ForAllTy tv ty) = Just (tv, ty)
@@ -1569,7 +1579,21 @@ tcSplitAppTys ty
                    Just (ty', arg) -> go ty' (arg:args)
                    Nothing         -> (ty,args)
 
+-- | Returns the number of arguments in the given type, without
+-- looking through synonyms. This is used only for error reporting.
+-- We don't look through synonyms because of #11313.
+tcRepGetNumAppTys :: Type -> Arity
+tcRepGetNumAppTys = length . snd . repSplitAppTys
+
 -----------------------
+-- | If the type is a tyvar, possibly under a cast, returns it, along
+-- with the coercion. Thus, the co is :: kind tv ~N kind type
+tcGetCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
+tcGetCastedTyVar_maybe ty | Just ty' <- tcView ty = tcGetCastedTyVar_maybe ty'
+tcGetCastedTyVar_maybe (CastTy (TyVarTy tv) co) = Just (tv, co)
+tcGetCastedTyVar_maybe (TyVarTy tv)             = Just (tv, mkNomReflCo (tyVarKind tv))
+tcGetCastedTyVar_maybe _                        = Nothing
+
 tcGetTyVar_maybe :: Type -> Maybe TyVar
 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
 tcGetTyVar_maybe (TyVarTy tv)   = Just tv
@@ -1728,7 +1752,7 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go True orig_env orig_ty1 orig_ty2
        -- be oversaturated
       where
         bndrs = tyConBinders tc
-        viss  = map (isVisibleArgFlag . tyConBinderArgFlag) bndrs
+        viss  = map isVisibleTyConBinder bndrs
     tc_vis False _ = repeat False  -- if we're not in a visible context, our args
                                    -- aren't either
 
@@ -2559,8 +2583,11 @@ sizeType = go
     go (TyVarTy {})              = 1
     go (TyConApp tc tys)
       | isTypeFamilyTyCon tc     = infinity  -- Type-family applications can
-                                           -- expand to any arbitrary size
+                                             -- expand to any arbitrary size
       | otherwise                = sizeTypes (filterOutInvisibleTypes tc tys) + 1
+                                   -- Why filter out invisible args?  I suppose any
+                                   -- size ordering is sound, but why is this better?
+                                   -- I came across this when investigating #14010.
     go (LitTy {})                = 1
     go (FunTy arg res)           = go arg + go res + 1
     go (AppTy fun arg)           = go fun + go arg
@@ -2572,3 +2599,28 @@ sizeType = go
 
 sizeTypes :: [Type] -> TypeSize
 sizeTypes tys = sum (map sizeType tys)
+
+-----------------------------------------------------------------------------------
+-----------------------------------------------------------------------------------
+-----------------------
+-- | For every arg a tycon can take, the returned list says True if the argument
+-- is taken visibly, and False otherwise. Ends with an infinite tail of Trues to
+-- allow for oversaturation.
+tcTyConVisibilities :: TyCon -> [Bool]
+tcTyConVisibilities tc = tc_binder_viss ++ tc_return_kind_viss ++ repeat True
+  where
+    tc_binder_viss      = map isVisibleTyConBinder (tyConBinders tc)
+    tc_return_kind_viss = map isVisibleBinder (fst $ tcSplitPiTys (tyConResKind tc))
+
+-- | If the tycon is applied to the types, is the next argument visible?
+isNextTyConArgVisible :: TyCon -> [Type] -> Bool
+isNextTyConArgVisible tc tys
+  = tcTyConVisibilities tc `getNth` length tys
+
+-- | Should this type be applied to a visible argument?
+isNextArgVisible :: TcType -> Bool
+isNextArgVisible ty
+  | Just (bndr, _) <- tcSplitPiTy_maybe ty = isVisibleBinder bndr
+  | otherwise                              = True
+    -- this second case might happen if, say, we have an unzonked TauTv.
+    -- But TauTvs can't range over types that take invisible arguments
diff --git a/compiler/typecheck/TcUnify.hs b/compiler/typecheck/TcUnify.hs
index 1cbf5741b2..b792f955c4 100644
--- a/compiler/typecheck/TcUnify.hs
+++ b/compiler/typecheck/TcUnify.hs
@@ -16,7 +16,7 @@ module TcUnify (
   checkConstraints, buildImplicationFor,
 
   -- Various unifications
-  unifyType, unifyTheta, unifyKind, noThing,
+  unifyType, unifyTheta, unifyKind,
   uType, promoteTcType,
   swapOverTyVars, canSolveByUnification,
 
@@ -201,10 +201,9 @@ matchExpectedFunTys herald arity orig_ty thing_inside
 
 -- Like 'matchExpectedFunTys', but used when you have an "actual" type,
 -- for example in function application
-matchActualFunTys :: Outputable a
-                  => SDoc   -- See Note [Herald for matchExpectedFunTys]
+matchActualFunTys :: SDoc   -- See Note [Herald for matchExpectedFunTys]
                   -> CtOrigin
-                  -> Maybe a   -- the thing with type TcSigmaType
+                  -> Maybe (HsExpr GhcRn)   -- the thing with type TcSigmaType
                   -> Arity
                   -> TcSigmaType
                   -> TcM (HsWrapper, [TcSigmaType], TcSigmaType)
@@ -215,10 +214,9 @@ matchActualFunTys herald ct_orig mb_thing arity ty
 
 -- | Variant of 'matchActualFunTys' that works when supplied only part
 -- (that is, to the right of some arrows) of the full function type
-matchActualFunTysPart :: Outputable a
-                      => SDoc -- See Note [Herald for matchExpectedFunTys]
+matchActualFunTysPart :: SDoc -- See Note [Herald for matchExpectedFunTys]
                       -> CtOrigin
-                      -> Maybe a  -- the thing with type TcSigmaType
+                      -> Maybe (HsExpr GhcRn)  -- the thing with type TcSigmaType
                       -> Arity
                       -> TcSigmaType
                       -> [TcSigmaType] -- reversed args. See (*) below.
@@ -391,7 +389,7 @@ matchExpectedTyConApp tc orig_ty
     -- kind-compatible with T.  For example, suppose we have
     --       matchExpectedTyConApp T (f Maybe)
     -- where data T a = MkT a
-    -- Then we don't want to instantate T's data constructors with
+    -- Then we don't want to instantiate T's data constructors with
     --    (a::*) ~ Maybe
     -- because that'll make types that are utterly ill-kinded.
     -- This happened in Trac #7368
@@ -400,7 +398,7 @@ matchExpectedTyConApp tc orig_ty
            ; traceTc "matchExpectedTyConApp" (ppr tc $$ ppr (tyConTyVars tc) $$ ppr arg_tvs)
            ; let args = mkTyVarTys arg_tvs
                  tc_template = mkTyConApp tc args
-           ; co <- unifyType noThing tc_template orig_ty
+           ; co <- unifyType Nothing tc_template orig_ty
            ; return (co, args) }
 
 ----------------------
@@ -432,7 +430,7 @@ matchExpectedAppTy orig_ty
     defer
       = do { ty1 <- newFlexiTyVarTy kind1
            ; ty2 <- newFlexiTyVarTy kind2
-           ; co <- unifyType noThing (mkAppTy ty1 ty2) orig_ty
+           ; co <- unifyType Nothing (mkAppTy ty1 ty2) orig_ty
            ; return (co, (ty1, ty2)) }
 
     orig_kind = typeKind orig_ty
@@ -531,9 +529,8 @@ skolemising the type.
 
 -- | Call this variant when you are in a higher-rank situation and
 -- you know the right-hand type is deeply skolemised.
-tcSubTypeHR :: Outputable a
-            => CtOrigin    -- ^ of the actual type
-            -> Maybe a     -- ^ If present, it has type ty_actual
+tcSubTypeHR :: CtOrigin               -- ^ of the actual type
+            -> Maybe (HsExpr GhcRn)   -- ^ If present, it has type ty_actual
             -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
 tcSubTypeHR orig = tcSubTypeDS_NC_O orig GenSigCtxt
 
@@ -547,7 +544,8 @@ tcSubTypeET orig ctxt (Check ty_actual) ty_expected
   where
     eq_orig = TypeEqOrigin { uo_actual   = ty_expected
                            , uo_expected = ty_actual
-                           , uo_thing    = Nothing }
+                           , uo_thing    = Nothing
+                           , uo_visible  = True }
 
 tcSubTypeET _ _ (Infer inf_res) ty_expected
   = ASSERT2( not (ir_inst inf_res), ppr inf_res $$ ppr ty_expected )
@@ -566,7 +564,7 @@ tcSubTypeO orig ctxt ty_actual ty_expected
                                        , pprUserTypeCtxt ctxt
                                        , ppr ty_actual
                                        , ppr ty_expected ])
-       ; tcSubTypeDS_NC_O orig ctxt noThing ty_actual ty_expected }
+       ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }
 
 addSubTypeCtxt :: TcType -> ExpType -> TcM a -> TcM a
 addSubTypeCtxt ty_actual ty_expected thing_inside
@@ -605,7 +603,8 @@ tcSubType_NC ctxt ty_actual ty_expected
   where
     origin = TypeEqOrigin { uo_actual   = ty_actual
                           , uo_expected = ty_expected
-                          , uo_thing    = Nothing }
+                          , uo_thing    = Nothing
+                          , uo_visible  = True }
 
 tcSubTypeDS :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
 -- Just like tcSubType, but with the additional precondition that
@@ -613,12 +612,11 @@ tcSubTypeDS :: CtOrigin -> UserTypeCtxt -> TcSigmaType -> ExpRhoType -> TcM HsWr
 tcSubTypeDS orig ctxt ty_actual ty_expected
   = addSubTypeCtxt ty_actual ty_expected $
     do { traceTc "tcSubTypeDS_NC" (vcat [pprUserTypeCtxt ctxt, ppr ty_actual, ppr ty_expected])
-       ; tcSubTypeDS_NC_O orig ctxt noThing ty_actual ty_expected }
+       ; tcSubTypeDS_NC_O orig ctxt Nothing ty_actual ty_expected }
 
-tcSubTypeDS_NC_O :: Outputable a
-                 => CtOrigin   -- origin used for instantiation only
+tcSubTypeDS_NC_O :: CtOrigin   -- origin used for instantiation only
                  -> UserTypeCtxt
-                 -> Maybe a
+                 -> Maybe (HsExpr GhcRn)
                  -> TcSigmaType -> ExpRhoType -> TcM HsWrapper
 -- Just like tcSubType, but with the additional precondition that
 -- ty_expected is deeply skolemised
@@ -628,7 +626,8 @@ tcSubTypeDS_NC_O inst_orig ctxt m_thing ty_actual ty_expected
       Check ty      -> tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty
          where
            eq_orig = TypeEqOrigin { uo_actual = ty_actual, uo_expected = ty
-                                  , uo_thing = mkErrorThing <$> m_thing }
+                                  , uo_thing  = ppr <$> m_thing
+                                  , uo_visible = True }
 
 ---------------
 tc_sub_tc_type :: CtOrigin   -- used when calling uType
@@ -643,7 +642,7 @@ tc_sub_tc_type eq_orig inst_orig ctxt ty_actual ty_expected
          vcat [ text "ty_actual   =" <+> ppr ty_actual
               , text "ty_expected =" <+> ppr ty_expected ]
        ; mkWpCastN <$>
-         uType eq_orig TypeLevel ty_actual ty_expected }
+         uType TypeLevel eq_orig ty_actual ty_expected }
 
   | otherwise   -- This is the general case
   = do { traceTc "tc_sub_tc_type (general case)" $
@@ -789,29 +788,29 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected
                                   -> eq_orig { uo_actual = rho_a }
                                 _ -> eq_orig
 
-                        ; cow <- uType eq_orig' TypeLevel rho_a ty_expected
+                        ; cow <- uType TypeLevel eq_orig' rho_a ty_expected
                         ; return (mkWpCastN cow <.> wrap) }
 
 
      -- use versions without synonyms expanded
-    unify = mkWpCastN <$> uType eq_orig TypeLevel ty_actual ty_expected
+    unify = mkWpCastN <$> uType TypeLevel eq_orig ty_actual ty_expected
 
 -----------------
 -- needs both un-type-checked (for origins) and type-checked (for wrapping)
 -- expressions
 tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
              -> TcM (HsExpr GhcTcId)
-tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr)
+tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr
 
 -- | Sometimes we don't have a @HsExpr Name@ to hand, and this is more
 -- convenient.
-tcWrapResultO :: CtOrigin -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
+tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
                -> TcM (HsExpr GhcTcId)
-tcWrapResultO orig expr actual_ty res_ty
+tcWrapResultO orig rn_expr expr actual_ty res_ty
   = do { traceTc "tcWrapResult" (vcat [ text "Actual:  " <+> ppr actual_ty
                                       , text "Expected:" <+> ppr res_ty ])
        ; cow <- tcSubTypeDS_NC_O orig GenSigCtxt
-                                 (Just expr) actual_ty res_ty
+                                 (Just rn_expr) actual_ty res_ty
        ; return (mkHsWrap cow expr) }
 
 -----------------------------------
@@ -958,7 +957,8 @@ promoteTcType dest_lvl ty
            ; prom_ty <- newMetaTyVarTyAtLevel dest_lvl (tYPE rr)
            ; let eq_orig = TypeEqOrigin { uo_actual   = ty
                                         , uo_expected = prom_ty
-                                        , uo_thing    = Nothing }
+                                        , uo_thing    = Nothing
+                                        , uo_visible  = False }
 
            ; co <- emitWantedEq eq_orig TypeLevel Nominal ty prom_ty
            ; return (co, prom_ty) }
@@ -969,8 +969,9 @@ promoteTcType dest_lvl ty
            ; let ty_kind = typeKind ty
                  kind_orig = TypeEqOrigin { uo_actual   = ty_kind
                                           , uo_expected = res_kind
-                                          , uo_thing    = Nothing }
-           ; ki_co <- uType kind_orig KindLevel (typeKind ty) res_kind
+                                          , uo_thing    = Nothing
+                                          , uo_visible  = False }
+           ; ki_co <- uType KindLevel kind_orig (typeKind ty) res_kind
            ; let co = mkTcNomReflCo ty `mkTcCoherenceRightCo` ki_co
            ; return (co, ty `mkCastTy` ki_co) }
 
@@ -1184,32 +1185,28 @@ The exported functions are all defined as versions of some
 non-exported generic functions.
 -}
 
-unifyType :: Outputable a => Maybe a   -- ^ If present, has type 'ty1'
+unifyType :: Maybe (HsExpr GhcRn)   -- ^ If present, has type 'ty1'
           -> TcTauType -> TcTauType -> TcM TcCoercionN
 -- Actual and expected types
 -- Returns a coercion : ty1 ~ ty2
 unifyType thing ty1 ty2 = traceTc "utype" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>
-                          uType origin TypeLevel ty1 ty2
+                          uType TypeLevel origin ty1 ty2
   where
     origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2
-                          , uo_thing  = mkErrorThing <$> thing }
+                          , uo_thing  = ppr <$> thing
+                          , uo_visible = True } -- always called from a visible context
 
--- | Use this instead of 'Nothing' when calling 'unifyType' without
--- a good "thing" (where the "thing" has the "actual" type passed in)
--- This has an 'Outputable' instance, avoiding amgiguity problems.
-noThing :: Maybe (HsExpr GhcRn)
-noThing = Nothing
-
-unifyKind :: Outputable a => Maybe a -> TcKind -> TcKind -> TcM CoercionN
+unifyKind :: Maybe (HsType GhcRn) -> TcKind -> TcKind -> TcM CoercionN
 unifyKind thing ty1 ty2 = traceTc "ukind" (ppr ty1 $$ ppr ty2 $$ ppr thing) >>
-                          uType origin KindLevel ty1 ty2
+                          uType KindLevel origin ty1 ty2
   where origin = TypeEqOrigin { uo_actual = ty1, uo_expected = ty2
-                              , uo_thing  = mkErrorThing <$> thing }
+                              , uo_thing  = ppr <$> thing
+                              , uo_visible = True } -- also always from a visible context
 
 ---------------
 unifyPred :: PredType -> PredType -> TcM TcCoercionN
 -- Actual and expected types
-unifyPred = unifyType noThing
+unifyPred = unifyType Nothing
 
 ---------------
 unifyTheta :: TcThetaType -> TcThetaType -> TcM [TcCoercionN]
@@ -1231,8 +1228,8 @@ uType is the heart of the unifier.
 -}
 
 uType, uType_defer
-  :: CtOrigin
-  -> TypeOrKind
+  :: TypeOrKind
+  -> CtOrigin
   -> TcType    -- ty1 is the *actual* type
   -> TcType    -- ty2 is the *expected* type
   -> TcM Coercion
@@ -1240,7 +1237,7 @@ uType, uType_defer
 --------------
 -- It is always safe to defer unification to the main constraint solver
 -- See Note [Deferred unification]
-uType_defer origin t_or_k ty1 ty2
+uType_defer t_or_k origin ty1 ty2
   = do { co <- emitWantedEq origin t_or_k Nominal ty1 ty2
 
        -- Error trace only
@@ -1255,7 +1252,7 @@ uType_defer origin t_or_k ty1 ty2
        ; return co }
 
 --------------
-uType origin t_or_k orig_ty1 orig_ty2
+uType t_or_k origin orig_ty1 orig_ty2
   = do { tclvl <- getTcLevel
        ; traceTc "u_tys" $ vcat
               [ text "tclvl" <+> ppr tclvl
@@ -1315,8 +1312,8 @@ uType origin t_or_k orig_ty1 orig_ty2
 
         -- Functions (or predicate functions) just check the two parts
     go (FunTy fun1 arg1) (FunTy fun2 arg2)
-      = do { co_l <- uType origin t_or_k fun1 fun2
-           ; co_r <- uType origin t_or_k arg1 arg2
+      = do { co_l <- uType t_or_k origin fun1 fun2
+           ; co_r <- uType t_or_k origin arg1 arg2
            ; return $ mkFunCo Nominal co_l co_r }
 
         -- Always defer if a type synonym family (type function)
@@ -1330,8 +1327,11 @@ uType origin t_or_k orig_ty1 orig_ty2
       -- See Note [Mismatched type lists and application decomposition]
       | tc1 == tc2, equalLength tys1 tys2
       = ASSERT2( isGenerativeTyCon tc1 Nominal, ppr tc1 )
-        do { cos <- zipWithM (uType origin t_or_k) tys1 tys2
+        do { cos <- zipWith3M (uType t_or_k) origins' tys1 tys2
            ; return $ mkTyConAppCo Nominal tc1 cos }
+      where
+        origins' = map (\is_vis -> if is_vis then origin else toInvisibleOrigin origin)
+                       (tcTyConVisibilities tc1)
 
     go (LitTy m) ty@(LitTy n)
       | m == n
@@ -1341,24 +1341,24 @@ uType origin t_or_k orig_ty1 orig_ty2
         -- Do not decompose FunTy against App;
         -- it's often a type error, so leave it for the constraint solver
     go (AppTy s1 t1) (AppTy s2 t2)
-      = go_app s1 t1 s2 t2
+      = go_app (isNextArgVisible s1) s1 t1 s2 t2
 
     go (AppTy s1 t1) (TyConApp tc2 ts2)
       | Just (ts2', t2') <- snocView ts2
       = ASSERT( mightBeUnsaturatedTyCon tc2 )
-        go_app s1 t1 (TyConApp tc2 ts2') t2'
+        go_app (isNextTyConArgVisible tc2 ts2') s1 t1 (TyConApp tc2 ts2') t2'
 
     go (TyConApp tc1 ts1) (AppTy s2 t2)
       | Just (ts1', t1') <- snocView ts1
       = ASSERT( mightBeUnsaturatedTyCon tc1 )
-        go_app (TyConApp tc1 ts1') t1' s2 t2
+        go_app (isNextTyConArgVisible tc1 ts1') (TyConApp tc1 ts1') t1' s2 t2
 
     go (CoercionTy co1) (CoercionTy co2)
       = do { let ty1 = coercionType co1
                  ty2 = coercionType co2
-           ; kco <- uType (KindEqOrigin orig_ty1 (Just orig_ty2) origin
+           ; kco <- uType KindLevel
+                          (KindEqOrigin orig_ty1 (Just orig_ty2) origin
                                         (Just t_or_k))
-                          KindLevel
                           ty1 ty2
            ; return $ mkProofIrrelCo Nominal kco co1 co2 }
 
@@ -1369,12 +1369,15 @@ uType origin t_or_k orig_ty1 orig_ty2
     ------------------
     defer ty1 ty2   -- See Note [Check for equality before deferring]
       | ty1 `tcEqType` ty2 = return (mkNomReflCo ty1)
-      | otherwise          = uType_defer origin t_or_k ty1 ty2
+      | otherwise          = uType_defer t_or_k origin ty1 ty2
 
     ------------------
-    go_app s1 t1 s2 t2
-      = do { co_s <- uType origin t_or_k s1 s2
-           ; co_t <- uType origin t_or_k t1 t2
+    go_app vis s1 t1 s2 t2
+      = do { co_s <- uType t_or_k origin s1 s2
+           ; let arg_origin
+                   | vis       = origin
+                   | otherwise = toInvisibleOrigin origin
+           ; co_t <- uType t_or_k arg_origin t1 t2
            ; return $ mkAppCo co_s co_t }
 
 {- Note [Check for equality before deferring]
@@ -1528,12 +1531,17 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
     go dflags cur_lvl
       | canSolveByUnification cur_lvl tv1 ty2
       , Just ty2' <- metaTyVarUpdateOK dflags tv1 ty2
-      = do { co_k <- uType kind_origin KindLevel (typeKind ty2') (tyVarKind tv1)
-           ; co   <- updateMeta tv1 ty2' co_k
-           ; return (maybe_sym swapped co) }
+      = do { co_k <- uType KindLevel kind_origin (typeKind ty2') (tyVarKind tv1)
+           ; if isTcReflCo co_k  -- only proceed if the kinds matched.
+
+             then do { writeMetaTyVar tv1 ty2'
+                     ; return (mkTcNomReflCo ty2') }
+             else defer } -- this cannot be solved now.
+                          -- See Note [Equalities with incompatible kinds]
+                          -- in TcCanonical
 
       | otherwise
-      = unSwap swapped (uType_defer origin t_or_k) ty1 ty2
+      = defer
                -- Occurs check or an untouchable: just defer
                -- NB: occurs check isn't necessarily fatal:
                --     eg tv1 occured in type family parameter
@@ -1541,10 +1549,7 @@ uUnfilledVar2 origin t_or_k swapped tv1 ty2
     ty1 = mkTyVarTy tv1
     kind_origin = KindEqOrigin ty1 (Just ty2) origin (Just t_or_k)
 
--- | apply sym iff swapped
-maybe_sym :: SwapFlag -> Coercion -> Coercion
-maybe_sym IsSwapped  = mkSymCo
-maybe_sym NotSwapped = id
+    defer = unSwap swapped (uType_defer t_or_k origin) ty1 ty2
 
 swapOverTyVars :: TcTyVar -> TcTyVar -> Bool
 swapOverTyVars tv1 tv2
@@ -1768,18 +1773,6 @@ lookupTcTyVar tyvar
   where
     details = tcTyVarDetails tyvar
 
--- | Fill in a meta-tyvar
-updateMeta :: TcTyVar            -- ^ tv to fill in, tv :: k1
-           -> TcType             -- ^ ty2 :: k2
-           -> Coercion           -- ^ kind_co :: k2 ~N k1
-           -> TcM Coercion       -- ^ :: tv ~N ty2 (= ty2 |> kind_co ~N ty2)
-updateMeta tv1 ty2 kind_co
-  = do { let ty2'     = ty2 `mkCastTy` kind_co
-             ty2_refl = mkNomReflCo ty2
-             co       = mkCoherenceLeftCo ty2_refl kind_co
-       ; writeMetaTyVar tv1 ty2'
-       ; return co }
-
 {-
 Note [Unifying untouchables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1789,12 +1782,12 @@ we return a made-up TcTyVarDetails, but I think it works smoothly.
 -}
 
 -- | Breaks apart a function kind into its pieces.
-matchExpectedFunKind :: Arity           -- ^ # of args remaining, only for errors
-                     -> TcType          -- ^ type, only for errors
+matchExpectedFunKind :: Outputable fun
+                     => fun             -- ^ type, only for errors
                      -> TcKind          -- ^ function kind
                      -> TcM (Coercion, TcKind, TcKind)
                                   -- ^ co :: old_kind ~ arg -> res
-matchExpectedFunKind num_args_remaining ty = go
+matchExpectedFunKind hs_ty = go
   where
     go k | Just k' <- tcView k = go k'
 
@@ -1812,12 +1805,12 @@ matchExpectedFunKind num_args_remaining ty = go
       = do { arg_kind <- newMetaKindVar
            ; res_kind <- newMetaKindVar
            ; let new_fun = mkFunTy arg_kind res_kind
-                 thing   = mkTypeErrorThingArgs ty num_args_remaining
                  origin  = TypeEqOrigin { uo_actual   = k
                                         , uo_expected = new_fun
-                                        , uo_thing    = Just thing
+                                        , uo_thing    = Just (ppr hs_ty)
+                                        , uo_visible  = True
                                         }
-           ; co <- uType origin KindLevel k new_fun
+           ; co <- uType KindLevel origin k new_fun
            ; return (co, arg_kind, res_kind) }
 
 
diff --git a/compiler/typecheck/TcUnify.hs-boot b/compiler/typecheck/TcUnify.hs-boot
index 9af4c27775..5335c15db7 100644
--- a/compiler/typecheck/TcUnify.hs-boot
+++ b/compiler/typecheck/TcUnify.hs-boot
@@ -2,13 +2,12 @@ module TcUnify where
 import TcType      ( TcTauType )
 import TcRnTypes   ( TcM )
 import TcEvidence  ( TcCoercion )
-import Outputable  ( Outputable )
 import HsExpr      ( HsExpr )
+import HsTypes     ( HsType )
 import HsExtension ( GhcRn )
 
 -- This boot file exists only to tie the knot between
 --              TcUnify and Inst
 
-unifyType :: Outputable a => Maybe a -> TcTauType -> TcTauType -> TcM TcCoercion
-unifyKind :: Outputable a => Maybe a -> TcTauType -> TcTauType -> TcM TcCoercion
-noThing   :: Maybe (HsExpr GhcRn)
+unifyType :: Maybe (HsExpr GhcRn) -> TcTauType -> TcTauType -> TcM TcCoercion
+unifyKind :: Maybe (HsType GhcRn) -> TcTauType -> TcTauType -> TcM TcCoercion
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs
index 4f7507745e..d8e2519fed 100644
--- a/compiler/typecheck/TcValidity.hs
+++ b/compiler/typecheck/TcValidity.hs
@@ -56,13 +56,13 @@ import Util
 import ListSetOps
 import SrcLoc
 import Outputable
-import BasicTypes
 import Module
 import Unique      ( mkAlphaTyVarUnique )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.List        ( (\\) )
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -973,13 +973,13 @@ constraintSynErr env kind
     , hang (text "Illegal constraint synonym of kind:" <+> quotes (ppr_tidy env kind))
          2 (parens constraintKindsMsg) )
 
-dupPredWarn :: TidyEnv -> [[PredType]] -> (TidyEnv, SDoc)
+dupPredWarn :: TidyEnv -> [NE.NonEmpty PredType] -> (TidyEnv, SDoc)
 dupPredWarn env dups
   = ( env
     , text "Duplicate constraint" <> plural primaryDups <> text ":"
       <+> pprWithCommas (ppr_tidy env) primaryDups )
   where
-    primaryDups = map head dups
+    primaryDups = map NE.head dups
 
 tyConArityErr :: TyCon -> [TcType] -> SDoc
 -- For type-constructor arity errors, be careful to report
@@ -1201,7 +1201,7 @@ It checks for three things
     might be applications thus (f (g x)).
 
     Note that tys only includes the visible arguments of the class type
-    constructor. Including the non-vivisble arguments can cause the following,
+    constructor. Including the non-visible arguments can cause the following,
     perfectly valid instance to be rejected:
        class Category (cat :: k -> k -> *) where ...
        newtype T (c :: * -> * -> *) a b = MkT (c a b)
@@ -1540,13 +1540,13 @@ type AssocInstArgShape = (Maybe Type, Type)
 checkConsistentFamInst
                :: Maybe ClsInstInfo
                -> TyCon              -- ^ Family tycon
-               -> [TyVar]            -- ^ Type variables of the family instance
                -> [Type]             -- ^ Type patterns from instance
+               -> SDoc               -- ^ pretty-printed user-written instance head
                -> TcM ()
 -- See Note [Checking consistent instantiation]
 
 checkConsistentFamInst Nothing _ _ _ = return ()
-checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc _at_tvs at_tys
+checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc at_tys pp_hs_pats
   = do { -- Check that the associated type indeed comes from this class
          checkTc (Just clas == tyConAssoc_maybe fam_tc)
                  (badATErr (className clas) (tyConName fam_tc))
@@ -1579,7 +1579,7 @@ checkConsistentFamInst (Just (clas, inst_tvs, mini_env)) fam_tc _at_tvs at_tys
 
     pp_exp_act
       = vcat [ text "Expected:" <+> ppr (mkTyConApp fam_tc expected_args)
-             , text "  Actual:" <+> ppr (mkTyConApp fam_tc at_tys)
+             , text "  Actual:" <+> pp_hs_pats
              , sdocWithDynFlags $ \dflags ->
                ppWhen (has_poly_args dflags) $
                vcat [ text "where the `<tv>' arguments are type variables,"
@@ -1669,7 +1669,9 @@ checkValidCoAxBranch mb_clsinfo fam_tc
                     (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
                                 , cab_lhs = typats
                                 , cab_rhs = rhs, cab_loc = loc })
-  = checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs loc
+  = checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs pp_lhs loc
+  where
+    pp_lhs = ppr (mkTyConApp fam_tc typats)
 
 -- | Do validity checks on a type family equation, including consistency
 -- with any enclosing class instance head, termination, and lack of
@@ -1680,11 +1682,12 @@ checkValidTyFamEqn :: Maybe ClsInstInfo
                    -> [CoVar] -- ^ bound covars in the equation
                    -> [Type]  -- ^ type patterns
                    -> Type    -- ^ rhs
+                   -> SDoc    -- ^ user-written LHS
                    -> SrcSpan
                    -> TcM ()
-checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs loc
+checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs pp_lhs loc
   = setSrcSpan loc $
-    do { checkValidFamPats mb_clsinfo fam_tc tvs cvs typats
+    do { checkValidFamPats mb_clsinfo fam_tc tvs cvs typats [] pp_lhs
 
          -- The argument patterns, and RHS, are all boxed tau types
          -- E.g  Reject type family F (a :: k1) :: k2
@@ -1722,7 +1725,11 @@ checkFamInstRhs lhsTys famInsts
         what    = text "type family application" <+> quotes (pprType (TyConApp tc tys))
         bad_tvs = fvTypes tys \\ fvs
 
-checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar] -> [Type] -> TcM ()
+checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar]
+                  -> [Type]   -- ^ patterns the user wrote
+                  -> [Type]   -- ^ "extra" patterns from a data instance kind sig
+                  -> SDoc     -- ^ pretty-printed user-written instance head
+                  -> TcM ()
 -- Patterns in a 'type instance' or 'data instance' decl should
 -- a) contain no type family applications
 --    (vanilla synonyms are fine, though)
@@ -1730,29 +1737,16 @@ checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar] -> [Type]
 --    e.g. we disallow (Trac #7536)
 --         type T a = Int
 --         type instance F (T a) = a
--- c) Have the right number of patterns
--- d) For associated types, are consistently instantiated
-checkValidFamPats mb_clsinfo fam_tc tvs cvs ty_pats
-  = do { -- A family instance must have exactly the same number of type
-         -- parameters as the family declaration.  You can't write
-         --     type family F a :: * -> *
-         --     type instance F Int y = y
-         -- because then the type (F Int) would be like (\y.y)
-         checkTc (ty_pats `lengthIs` fam_arity) $
-           wrongNumberOfParmsErr (fam_arity - count isInvisibleTyConBinder fam_bndrs)
-             -- report only explicit arguments
-
-       ; mapM_ checkValidTypePat ty_pats
-
-       ; let unbound_tcvs = filterOut (`elemVarSet` exactTyCoVarsOfTypes ty_pats) (tvs ++ cvs)
-       ; checkTc (null unbound_tcvs) (famPatErr fam_tc unbound_tcvs ty_pats)
+-- c) For associated types, are consistently instantiated
+checkValidFamPats mb_clsinfo fam_tc tvs cvs user_ty_pats extra_ty_pats pp_hs_pats
+  = do { mapM_ checkValidTypePat user_ty_pats
 
-         -- Check that type patterns match the class instance head
-       ; checkConsistentFamInst mb_clsinfo fam_tc tvs ty_pats }
-  where
-     fam_arity = tyConArity fam_tc
-     fam_bndrs = tyConBinders fam_tc
+       ; let unbound_tcvs = filterOut (`elemVarSet` exactTyCoVarsOfTypes user_ty_pats)
+                                      (tvs ++ cvs)
+       ; checkTc (null unbound_tcvs) (famPatErr fam_tc unbound_tcvs user_ty_pats)
 
+         -- Check that type patterns match the class instance head
+       ; checkConsistentFamInst mb_clsinfo fam_tc (user_ty_pats `chkAppend` extra_ty_pats) pp_hs_pats }
 
 checkValidTypePat :: Type -> TcM ()
 -- Used for type patterns in class instances,
@@ -1774,11 +1768,6 @@ isTyFamFree = null . tcTyFamInsts
 
 -- Error messages
 
-wrongNumberOfParmsErr :: Arity -> SDoc
-wrongNumberOfParmsErr exp_arity
-  = text "Number of parameters must match family declaration; expected"
-    <+> ppr exp_arity
-
 inaccessibleCoAxBranch :: CoAxiom br -> CoAxBranch -> SDoc
 inaccessibleCoAxBranch fi_ax cur_branch
   = text "Type family instance equation is overlapped:" $$
diff --git a/compiler/types/Class.hs b/compiler/types/Class.hs
index ae1047ebde..b981a4998e 100644
--- a/compiler/types/Class.hs
+++ b/compiler/types/Class.hs
@@ -60,6 +60,10 @@ data Class
 
         classTyVars  :: [TyVar],        -- The class kind and type variables;
                                         -- identical to those of the TyCon
+           -- If you want visiblity info, look at the classTyCon
+           -- This field is redundant because it's duplicated in the
+           -- classTyCon, but classTyVars is used quite often, so maybe
+           -- it's a bit faster to cache it here
 
         classFunDeps :: [FunDep TyVar],  -- The functional dependencies
 
diff --git a/compiler/types/Coercion.hs b/compiler/types/Coercion.hs
index 3f5036c4dd..214fe2d92e 100644
--- a/compiler/types/Coercion.hs
+++ b/compiler/types/Coercion.hs
@@ -95,7 +95,7 @@ module Coercion (
         seqCo,
 
         -- * Pretty-printing
-        pprCo, pprParendCo, pprCoBndr,
+        pprCo, pprParendCo,
         pprCoAxiom, pprCoAxBranch, pprCoAxBranchHdr,
 
         -- * Tidying
@@ -152,117 +152,32 @@ setCoVarUnique = setVarUnique
 setCoVarName :: CoVar -> Name -> CoVar
 setCoVarName   = setVarName
 
-
 {-
 %************************************************************************
 %*                                                                      *
-                   Pretty-printing coercions
+                   Pretty-printing CoAxioms
 %*                                                                      *
 %************************************************************************
 
-@pprCo@ is the standard @Coercion@ printer; the overloaded @ppr@
-function is defined to use this.  @pprParendCo@ is the same, except it
-puts parens around the type, except for the atomic cases.
-@pprParendCo@ works just by setting the initial context precedence
-very high.
--}
-
--- Outputable instances are in TyCoRep, to avoid orphans
-
-pprCo, pprParendCo :: Coercion -> SDoc
-pprCo       co = ppr_co TopPrec   co
-pprParendCo co = ppr_co TyConPrec co
-
-ppr_co :: TyPrec -> Coercion -> SDoc
-ppr_co _ (Refl r ty) = angleBrackets (ppr ty) <> ppr_role r
-
-ppr_co _ (TyConAppCo r tc cos) = pprTcAppCo TyConPrec ppr_co tc cos <> ppr_role r
-ppr_co p (AppCo co arg)        = maybeParen p TyConPrec $
-                                 pprCo co <+> ppr_co TyConPrec arg
-ppr_co p co@(ForAllCo {})      = ppr_forall_co p co
-ppr_co p co@(FunCo {})         = ppr_fun_co p co
-ppr_co _ (CoVarCo cv)          = parenSymOcc (getOccName cv) (ppr cv)
-ppr_co p (AxiomInstCo con index args)
-  = pprPrefixApp p (ppr (getName con) <> brackets (ppr index))
-                   (map (ppr_co TyConPrec) args)
-
-ppr_co p co@(TransCo {}) = maybeParen p FunPrec $
-                           case trans_co_list co [] of
-                             [] -> panic "ppr_co"
-                             (co:cos) -> sep ( ppr_co FunPrec co
-                                             : [ char ';' <+> ppr_co FunPrec co | co <- cos])
-ppr_co p (InstCo co arg) = maybeParen p TyConPrec $
-                           pprParendCo co <> text "@" <> ppr_co TopPrec arg
-
-ppr_co p (UnivCo UnsafeCoerceProv r ty1 ty2)
-  = pprPrefixApp p (text "UnsafeCo" <+> ppr r)
-                   [pprParendType ty1, pprParendType ty2]
-ppr_co _ (UnivCo p r t1 t2)
-  = char 'U'
-    <> parens (ppr_prov <> comma <+> ppr t1 <> comma <+> ppr t2)
-    <> ppr_role r
-  where
-    ppr_prov = case p of
-      HoleProv h          -> text "hole:"   <> ppr h
-      PhantomProv kind_co -> text "phant:"  <> ppr kind_co
-      ProofIrrelProv co   -> text "irrel:"  <> ppr co
-      PluginProv s        -> text "plugin:" <> text s
-      UnsafeCoerceProv    -> text "unsafe"
-
-ppr_co p (SymCo co)          = pprPrefixApp p (text "Sym") [pprParendCo co]
-ppr_co p (NthCo n co)        = pprPrefixApp p (text "Nth:" <> int n) [pprParendCo co]
-ppr_co p (LRCo sel co)       = pprPrefixApp p (ppr sel) [pprParendCo co]
-ppr_co p (CoherenceCo c1 c2) = maybeParen p TyConPrec $
-                               (ppr_co FunPrec c1) <+> (text "|>") <+>
-                               (ppr_co FunPrec c2)
-ppr_co p (KindCo co)         = pprPrefixApp p (text "kind") [pprParendCo co]
-ppr_co p (SubCo co)         = pprPrefixApp p (text "Sub") [pprParendCo co]
-ppr_co p (AxiomRuleCo co cs) = maybeParen p TopPrec $ ppr_axiom_rule_co co cs
-
-ppr_axiom_rule_co :: CoAxiomRule -> [Coercion] -> SDoc
-ppr_axiom_rule_co co ps = ppr (coaxrName co) <+> parens (interpp'SP ps)
-
-ppr_role :: Role -> SDoc
-ppr_role r = underscore <> pp_role
-  where pp_role = case r of
-                    Nominal          -> char 'N'
-                    Representational -> char 'R'
-                    Phantom          -> char 'P'
-
-trans_co_list :: Coercion -> [Coercion] -> [Coercion]
-trans_co_list (TransCo co1 co2) cos = trans_co_list co1 (trans_co_list co2 cos)
-trans_co_list co                cos = co : cos
-
-ppr_fun_co :: TyPrec -> Coercion -> SDoc
-ppr_fun_co p co = pprArrowChain p (split co)
-  where
-    split :: Coercion -> [SDoc]
-    split (FunCo _ arg res)
-      = ppr_co FunPrec arg : split res
-    split co = [ppr_co TopPrec co]
+Defined here to avoid module loops. CoAxiom is loaded very early on.
 
-ppr_forall_co :: TyPrec -> Coercion -> SDoc
-ppr_forall_co p (ForAllCo tv h co)
-  = maybeParen p FunPrec $
-    sep [pprCoBndr (tyVarName tv) h, ppr_co TopPrec co]
-ppr_forall_co _ _ = panic "ppr_forall_co"
-
-pprCoBndr :: Name -> Coercion -> SDoc
-pprCoBndr name eta =
-  forAllLit <+> parens (ppr name <+> dcolon <+> ppr eta) <> dot
+-}
 
 pprCoAxiom :: CoAxiom br -> SDoc
 pprCoAxiom ax@(CoAxiom { co_ax_branches = branches })
   = hang (text "axiom" <+> ppr ax <+> dcolon)
-       2 (vcat (map (ppr_co_ax_branch (const ppr) ax) $ fromBranches branches))
+       2 (vcat (map (ppr_co_ax_branch (const pprType) ax) $ fromBranches branches))
 
 pprCoAxBranch :: CoAxiom br -> CoAxBranch -> SDoc
 pprCoAxBranch = ppr_co_ax_branch pprRhs
   where
-    pprRhs fam_tc (TyConApp tycon _)
-      | isDataFamilyTyCon fam_tc
+    pprRhs fam_tc rhs
+      | Just (tycon, _) <- splitTyConApp_maybe rhs
+      , isDataFamilyTyCon fam_tc
       = pprDataCons tycon
-    pprRhs _ rhs = ppr rhs
+
+      | otherwise
+      = ppr rhs
 
 pprCoAxBranchHdr :: CoAxiom br -> BranchIndex -> SDoc
 pprCoAxBranchHdr ax index = pprCoAxBranch ax (coAxiomNthBranch ax index)
@@ -1598,6 +1513,8 @@ ty_co_subst lc role ty
   = go role ty
   where
     go :: Role -> Type -> Coercion
+    go r ty                | Just ty' <- coreView ty
+                           = go r ty'
     go Phantom ty          = lift_phantom ty
     go r (TyVarTy tv)      = expectJust "ty_co_subst bad roles" $
                              liftCoSubstTyVar lc r tv
diff --git a/compiler/types/Coercion.hs-boot b/compiler/types/Coercion.hs-boot
index dd10d6e5ca..d9aa234193 100644
--- a/compiler/types/Coercion.hs-boot
+++ b/compiler/types/Coercion.hs-boot
@@ -8,7 +8,6 @@ import {-# SOURCE #-} TyCon
 import BasicTypes ( LeftOrRight )
 import CoAxiom
 import Var
-import Outputable
 import Pair
 import Util
 
@@ -47,5 +46,3 @@ seqCo :: Coercion -> ()
 
 coercionKind :: Coercion -> Pair Type
 coercionType :: Coercion -> Type
-
-pprCo :: Coercion -> SDoc
diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 6d179a9a10..cec7b58e38 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -29,9 +29,8 @@ module FamInstEnv (
 
         -- Normalisation
         topNormaliseType, topNormaliseType_maybe,
-        normaliseType, normaliseTcApp,
+        normaliseType, normaliseTcApp, normaliseTcArgs,
         reduceTyFamApp_maybe,
-        pmTopNormaliseType_maybe,
 
         -- Flattening
         flattenTys
@@ -43,7 +42,6 @@ import Unify
 import Type
 import TyCoRep
 import TyCon
-import DataCon (DataCon)
 import Coercion
 import CoAxiom
 import VarSet
@@ -62,7 +60,7 @@ import SrcLoc
 import FastString
 import MonadUtils
 import Control.Monad
-import Data.List( mapAccumL, find )
+import Data.List( mapAccumL )
 
 {-
 ************************************************************************
@@ -125,8 +123,50 @@ data FamFlavor
   = SynFamilyInst         -- A synonym family
   | DataFamilyInst TyCon  -- A data family, with its representation TyCon
 
-{- Note [Eta reduction for data families]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{-
+Note [Arity of data families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Data family instances might legitimately be over- or under-saturated.
+
+Under-saturation has two potential causes:
+ U1) Eta reduction. See Note [Eta reduction for data families].
+ U2) When the user has specified a return kind instead of written out patterns.
+     Example:
+
+       data family Sing (a :: k)
+       data instance Sing :: Bool -> Type
+
+     The data family tycon Sing has an arity of 2, the k and the a. But
+     the data instance has only one pattern, Bool (standing in for k).
+     This instance is equivalent to `data instance Sing (a :: Bool)`, but
+     without the last pattern, we have an under-saturated data family instance.
+     On its own, this example is not compelling enough to add support for
+     under-saturation, but U1 makes this feature more compelling.
+
+Over-saturation is also possible:
+  O1) If the data family's return kind is a type variable (see also #12369),
+      an instance might legitimately have more arguments than the family.
+      Example:
+
+        data family Fix :: (Type -> k) -> k
+        data instance Fix f = MkFix1 (f (Fix f))
+        data instance Fix f x = MkFix2 (f (Fix f x) x)
+
+      In the first instance here, the k in the data family kind is chosen to
+      be Type. In the second, it's (Type -> Type).
+
+      However, we require that any over-saturation is eta-reducible. That is,
+      we require that any extra patterns be bare unrepeated type variables;
+      see Note [Eta reduction for data families]. Accordingly, the FamInst
+      is never over-saturated.
+
+Why can we allow such flexibility for data families but not for type families?
+Because data families can be decomposed -- that is, they are generative and
+injective. A Type family is neither and so always must be applied to all its
+arguments.
+
+Note [Eta reduction for data families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this
    data family T a b :: *
    newtype instance T Int a = MkT (IO a) deriving( Monad )
@@ -156,7 +196,7 @@ See also Note [Newtype eta] in TyCon.
 
 Bottom line:
   For a FamInst with fi_flavour = DataFamilyInst rep_tc,
-  - fi_tvs may be shorter than tyConTyVars of rep_tc
+  - fi_tvs may be shorter than tyConTyVars of rep_tc.
   - fi_tys may be shorter than tyConArity of the family tycon
        i.e. LHS is unsaturated
   - fi_rhs will be (rep_tc fi_tvs)
@@ -1232,114 +1272,6 @@ topNormaliseType_maybe env ty
           _              -> NS_Done
 
 ---------------
-pmTopNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Type, [DataCon], Type)
--- ^ Get rid of *outermost* (or toplevel)
---      * type function redex
---      * data family redex
---      * newtypes
---
--- Behaves exactly like `topNormaliseType_maybe`, but instead of returning a
--- coercion, it returns useful information for issuing pattern matching
--- warnings. See Note [Type normalisation for EmptyCase] for details.
-pmTopNormaliseType_maybe env typ
-  = do ((ty_f,tm_f), ty) <- topNormaliseTypeX stepper comb typ
-       return (eq_src_ty ty (typ : ty_f [ty]), tm_f [], ty)
-  where
-    -- Find the first type in the sequence of rewrites that is a data type,
-    -- newtype, or a data family application (not the representation tycon!).
-    -- This is the one that is equal (in source Haskell) to the initial type.
-    -- If none is found in the list, then all of them are type family
-    -- applications, so we simply return the last one, which is the *simplest*.
-    eq_src_ty :: Type -> [Type] -> Type
-    eq_src_ty ty tys = maybe ty id (find is_alg_or_data_family tys)
-
-    is_alg_or_data_family :: Type -> Bool
-    is_alg_or_data_family ty = isClosedAlgType ty || isDataFamilyAppType ty
-
-    -- For efficiency, represent both lists as difference lists.
-    -- comb performs the concatenation, for both lists.
-    comb (tyf1, tmf1) (tyf2, tmf2) = (tyf1 . tyf2, tmf1 . tmf2)
-
-    stepper = newTypeStepper `composeSteppers` tyFamStepper
-
-    -- A 'NormaliseStepper' that unwraps newtypes, careful not to fall into
-    -- a loop. If it would fall into a loop, it produces 'NS_Abort'.
-    newTypeStepper :: NormaliseStepper ([Type] -> [Type],[DataCon] -> [DataCon])
-    newTypeStepper rec_nts tc tys
-      | Just (ty', _co) <- instNewTyCon_maybe tc tys
-      = case checkRecTc rec_nts tc of
-          Just rec_nts' -> let tyf = ((TyConApp tc tys):)
-                               tmf = ((tyConSingleDataCon tc):)
-                           in  NS_Step rec_nts' ty' (tyf, tmf)
-          Nothing       -> NS_Abort
-      | otherwise
-      = NS_Done
-
-    tyFamStepper :: NormaliseStepper ([Type] -> [Type], [DataCon] -> [DataCon])
-    tyFamStepper rec_nts tc tys  -- Try to step a type/data family
-      = let (_args_co, ntys) = normaliseTcArgs env Representational tc tys in
-          -- NB: It's OK to use normaliseTcArgs here instead of
-          -- normalise_tc_args (which takes the LiftingContext described
-          -- in Note [Normalising types]) because the reduceTyFamApp below
-          -- works only at top level. We'll never recur in this function
-          -- after reducing the kind of a bound tyvar.
-
-        case reduceTyFamApp_maybe env Representational tc ntys of
-          Just (_co, rhs) -> NS_Step rec_nts rhs ((rhs:), id)
-          _               -> NS_Done
-
-{- Note [Type normalisation for EmptyCase]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-EmptyCase is an exception for pattern matching, since it is strict. This means
-that it boils down to checking whether the type of the scrutinee is inhabited.
-Function pmTopNormaliseType_maybe gets rid of the outermost type function/data
-family redex and newtypes, in search of an algebraic type constructor, which is
-easier to check for inhabitation.
-
-It returns 3 results instead of one, because there are 2 subtle points:
-1. Newtypes are isomorphic to the underlying type in core but not in the source
-   language,
-2. The representational data family tycon is used internally but should not be
-   shown to the user
-
-Hence, if pmTopNormaliseType_maybe env ty = Just (src_ty, dcs, core_ty), then
-  (a) src_ty is the rewritten type which we can show to the user. That is, the
-      type we get if we rewrite type families but not data families or
-      newtypes.
-  (b) dcs is the list of data constructors "skipped", every time we normalise a
-      newtype to it's core representation, we keep track of the source data
-      constructor.
-  (c) core_ty is the rewritten type. That is,
-        pmTopNormaliseType_maybe env ty = Just (src_ty, dcs, core_ty)
-      implies
-        topNormaliseType_maybe env ty = Just (co, core_ty)
-      for some coercion co.
-
-To see how all cases come into play, consider the following example:
-
-  data family T a :: *
-  data instance T Int = T1 | T2 Bool
-  -- Which gives rise to FC:
-  --   data T a
-  --   data R:TInt = T1 | T2 Bool
-  --   axiom ax_ti : T Int ~R R:TInt
-
-  newtype G1 = MkG1 (T Int)
-  newtype G2 = MkG2 G1
-
-  type instance F Int  = F Char
-  type instance F Char = G2
-
-In this case pmTopNormaliseType_maybe env (F Int) results in
-
-  Just (G2, [MkG2,MkG1], R:TInt)
-
-Which means that in source Haskell:
-  - G2 is equivalent to F Int (in contrast, G1 isn't).
-  - if (x : R:TInt) then (MkG2 (MkG1 x) : F Int).
--}
-
----------------
 normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)
 -- See comments on normaliseType for the arguments of this function
 normaliseTcApp env role tc tys
diff --git a/compiler/types/OptCoercion.hs b/compiler/types/OptCoercion.hs
index 67644094ed..f26351f3bd 100644
--- a/compiler/types/OptCoercion.hs
+++ b/compiler/types/OptCoercion.hs
@@ -4,9 +4,7 @@
 
 -- The default iteration limit is a bit too low for the definitions
 -- in this module.
-#if __GLASGOW_HASKELL__ >= 800
 {-# OPTIONS_GHC -fmax-pmcheck-iterations=10000000 #-}
-#endif
 
 module OptCoercion ( optCoercion, checkAxInstCo ) where
 
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 5ac63e5b04..8b8a960f72 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -18,7 +18,6 @@ Note [The Type-related module hierarchy]
 -- We expose the relevant stuff from this module via the Type module
 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf #-}
-{-# LANGUAGE ImplicitParams #-}
 
 module TyCoRep (
         TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,
@@ -62,10 +61,12 @@ module TyCoRep (
         pprTyVar, pprTyVars,
         pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit,
-        TyPrec(..), maybeParen, pprTcAppCo,
+        TyPrec(..), maybeParen,
         pprPrefixApp, pprArrowChain,
         pprDataCons, ppSuggestExplicitKinds,
 
+        pprCo, pprParendCo,
+
         -- * Free variables
         tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet,
         tyCoFVsBndr, tyCoFVsOfType, tyCoVarsOfTypeList,
@@ -93,7 +94,7 @@ module TyCoRep (
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
         extendTCvSubst,
         extendCvSubst, extendCvSubstWithClone,
-        extendTvSubst, extendTvSubstBinder, extendTvSubstWithClone,
+        extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone,
         extendTvSubstList, extendTvSubstAndInScope,
         unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,
         zipTvSubst, zipCvSubst,
@@ -137,15 +138,16 @@ import {-# SOURCE #-} DataCon( dataConFullSig
                              , dataConUnivTyVarBinders, dataConExTyVarBinders
                              , DataCon, filterEqSpec )
 import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy, mkCastTy
-                          , tyCoVarsOfTypesWellScoped
                           , tyCoVarsOfTypeWellScoped
+                          , tyCoVarsOfTypesWellScoped
+                          , toposortTyVars
                           , coreView, typeKind )
    -- Transitively pulls in a LOT of stuff, better to break the loop
 
 import {-# SOURCE #-} Coercion
 import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )
 import {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr
-                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercion )
+                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )
 
 -- friends:
 import IfaceType
@@ -457,28 +459,38 @@ words, if `x` is either a function or a polytype, `x arg` makes sense
 (for an appropriate `arg`).
 
 
-Note [TyBinders and ArgFlags]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A ForAllTy contains a TyVarBinder.  Each TyVarBinder is equipped
-with a ArgFlag, which says whether or not arguments for this
-binder should be visible (explicit) in source Haskell.
-
------------------------------------------------------------------------
-                                            Occurrences look like this
- TyBinder          GHC displays type as     in Haskell souce code
------------------------------------------------------------------------
-In the type of a term
- Anon:             f :: type -> type         Arg required:     f x
- Named Inferred:   f :: forall {a}. type     Arg not allowed:  f
- Named Specified:  f :: forall a. type       Arg optional:     f  or  f @Int
- Named Required:         Illegal: See Note [No Required TyBinder in terms]
-
-In the kind of a type
- Anon:             T :: kind -> kind         Required:            T *
- Named Inferred:   T :: forall {k}. kind     Arg not allowed:     T
- Named Specified:  T :: forall k. kind       Arg not allowed[1]:  T
- Named Required:   T :: forall k -> kind     Required:            T *
-------------------------------------------------------------------------
+Note [TyVarBndrs, TyVarBinders, TyConBinders, and visiblity]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* A ForAllTy (used for both types and kinds) contains a TyVarBinder.
+  Each TyVarBinder
+      TvBndr a tvis
+  is equipped with tvis::ArgFlag, which says whether or not arguments
+  for this binder should be visible (explicit) in source Haskell.
+
+* A TyCon contains a list of TyConBinders.  Each TyConBinder
+      TvBndr a cvis
+  is equipped with cvis::TyConBndrVis, which says whether or not type
+  and kind arguments for this TyCon should be visible (explicit) in
+  source Haskell.
+
+This table summarises the visiblity rules:
+---------------------------------------------------------------------------------------
+|                                                      Occurrences look like this
+|                             GHC displays type as     in Haskell source code
+|-----------------------------------------------------------------------
+| TvBndr a tvis :: TyVarBinder, in the binder of ForAllTy for a term
+|  tvis :: ArgFlag
+|  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f
+|  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int
+|  tvis = Required:   Illegal: See Note [No Required TyBinder in terms]
+|
+| TvBndr k cvis :: TyConBinder, in the TyConBinders of a TyCon
+|  cvis :: TyConBndrVis
+|  cvis = AnonTCB:             T :: kind -> kind        Required:            T *
+|  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T
+|  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T
+|  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *
+---------------------------------------------------------------------------------------
 
 [1] In types, in the Specified case, it would make sense to allow
     optional kind applications, thus (T @*), but we have not
@@ -1835,10 +1847,10 @@ extendTvSubst :: TCvSubst -> TyVar -> Type -> TCvSubst
 extendTvSubst (TCvSubst in_scope tenv cenv) tv ty
   = TCvSubst in_scope (extendVarEnv tenv tv ty) cenv
 
-extendTvSubstBinder :: TCvSubst -> TyBinder -> Type -> TCvSubst
-extendTvSubstBinder subst (Named bndr) ty
-  = extendTvSubst subst (binderVar bndr) ty
-extendTvSubstBinder subst (Anon _)     _
+extendTvSubstBinderAndInScope :: TCvSubst -> TyBinder -> Type -> TCvSubst
+extendTvSubstBinderAndInScope subst (Named bndr) ty
+  = extendTvSubstAndInScope subst (binderVar bndr) ty
+extendTvSubstBinderAndInScope subst (Anon _)     _
   = subst
 
 extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst
@@ -2435,7 +2447,7 @@ pprType       = pprPrecType TopPrec
 pprParendType = pprPrecType TyConPrec
 
 pprPrecType :: TyPrec -> Type -> SDoc
-pprPrecType prec ty = pprPrecIfaceType prec (tidyToIfaceType ty)
+pprPrecType prec ty = getPprStyle $ \sty -> pprPrecIfaceType prec (tidyToIfaceTypeSty ty sty)
 
 pprTyLit :: TyLit -> SDoc
 pprTyLit = pprIfaceTyLit . toIfaceTyLit
@@ -2444,6 +2456,12 @@ pprKind, pprParendKind :: Kind -> SDoc
 pprKind       = pprType
 pprParendKind = pprParendType
 
+tidyToIfaceTypeSty :: Type -> PprStyle -> IfaceType
+tidyToIfaceTypeSty ty sty
+  | userStyle sty = tidyToIfaceType ty
+  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty
+     -- in latter case, don't tidy, as we'll be printing uniques.
+
 tidyToIfaceType :: Type -> IfaceType
 -- It's vital to tidy before converting to an IfaceType
 -- or nested binders will become indistinguishable!
@@ -2457,6 +2475,29 @@ tidyToIfaceType ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env ty)
     free_tcvs = tyCoVarsOfTypeWellScoped ty
 
 ------------
+pprCo, pprParendCo :: Coercion -> SDoc
+pprCo       co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)
+pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)
+
+tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion
+tidyToIfaceCoSty co sty
+  | userStyle sty = tidyToIfaceCo co
+  | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co
+     -- in latter case, don't tidy, as we'll be printing uniques.
+
+tidyToIfaceCo :: Coercion -> IfaceCoercion
+-- It's vital to tidy before converting to an IfaceType
+-- or nested binders will become indistinguishable!
+--
+-- Also for the free type variables, tell toIfaceCoercionX to
+-- leave them as IfaceFreeCoVar.  This is super-important
+-- for debug printing.
+tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)
+  where
+    env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs
+    free_tcvs = toposortTyVars $ tyCoVarsOfCoList co
+
+------------
 pprClassPred :: Class -> [Type] -> SDoc
 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
 
@@ -2580,11 +2621,6 @@ pprTypeApp tc tys
                             (toIfaceTcArgs tc tys)
     -- TODO: toIfaceTcArgs seems rather wasteful here
 
-pprTcAppCo :: TyPrec -> (TyPrec -> Coercion -> SDoc)
-           -> TyCon -> [Coercion] -> SDoc
-pprTcAppCo p _pp tc cos
-  = pprIfaceCoTcApp p (toIfaceTyCon tc) (map toIfaceCoercion cos)
-
 ------------------
 
 pprPrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 1be318d96a..95207c493b 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -94,7 +94,7 @@ module TyCon(
         newTyConDataCon_maybe,
         algTcFields,
         tyConRuntimeRepInfo,
-        tyConBinders, tyConResKind,
+        tyConBinders, tyConResKind, tyConTyVarBinders,
         tcTyConScopedTyVars,
 
         -- ** Manipulating TyCons
@@ -222,7 +222,10 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
         DataFamInstTyCon T [Int] ax_ti
 
 * The axiom ax_ti may be eta-reduced; see
-  Note [Eta reduction for data family axioms] in TcInstDcls
+  Note [Eta reduction for data family axioms] in FamInstEnv
+
+* Data family instances may have a different arity than the data family.
+  See Note [Arity of data families] in FamInstEnv
 
 * The data constructor T2 has a wrapper (which is what the
   source-level "T2" invokes):
@@ -428,6 +431,72 @@ mkTyConKind bndrs res_kind = foldr mk res_kind bndrs
     mk (TvBndr tv AnonTCB)        k = mkFunKind (tyVarKind tv) k
     mk (TvBndr tv (NamedTCB vis)) k = mkForAllKind tv vis k
 
+tyConTyVarBinders :: [TyConBinder]   -- From the TyCon
+                  -> [TyVarBinder]   -- Suitable for the foralls of a term function
+-- See Note [Building TyVarBinders from TyConBinders]
+tyConTyVarBinders tc_bndrs
+ = map mk_binder tc_bndrs
+ where
+   mk_binder (TvBndr tv tc_vis) = mkTyVarBinder vis tv
+      where
+        vis = case tc_vis of
+                AnonTCB           -> Specified
+                NamedTCB Required -> Specified
+                NamedTCB vis      -> vis
+
+{- Note [Building TyVarBinders from TyConBinders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We sometimes need to build the quantified type of a value from
+the TyConBinders of a type or class.  For that we need not
+TyConBinders but TyVarBinders (used in forall-type)  E.g:
+
+ *  From   data T a = MkT (Maybe a)
+    we are going to make a data constructor with type
+           MkT :: forall a. Maybe a -> T a
+    See the TyVarBinders passed to buildDataCon
+
+ * From    class C a where { op :: a -> Maybe a }
+   we are going to make a default method
+           $dmop :: forall a. C a => a -> Maybe a
+   See the TyVarBindres passed to mkSigmaTy in mkDefaultMethodType
+
+Both of these are user-callable.  (NB: default methods are not callable
+directly by the user but rather via the code generated by 'deriving',
+which uses visible type application; see mkDefMethBind.)
+
+Since they are user-callable we must get their type-argument visibility
+information right; and that info is in the TyConBinders.
+Here is an example:
+
+  data App a b = MkApp (a b) -- App :: forall {k}. (k->*) -> k -> *
+
+The TyCon has
+
+  tyConTyBinders = [ Named (TvBndr (k :: *) Inferred), Anon (k->*), Anon k ]
+
+The TyConBinders for App line up with App's kind, given above.
+
+But the DataCon MkApp has the type
+  MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b
+
+That is, its TyVarBinders should be
+
+  dataConUnivTyVarBinders = [ TvBndr (k:*)    Inferred
+                            , TvBndr (a:k->*) Specified
+                            , TvBndr (b:k)    Specified ]
+
+So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:
+  - variable names from the TyConBinders
+  - but changing Anon/Required to Specified
+
+The last part about Required->Specified comes from this:
+  data T k (a:k) b = MkT (a b)
+Here k is Required in T's kind, but we don't have Required binders in
+the TyBinders for a term (see Note [No Required TyBinder in terms]
+in TyCoRep), so we change it to Specified when making MkT's TyBinders
+-}
+
+
 {- Note [The binders/kind/arity fields of a TyCon]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 All TyCons have this group of fields
@@ -451,8 +520,8 @@ They fit together like so:
   Note that that are three binders here, including the
   kind variable k.
 
-  See Note [TyBinders and ArgFlags] in TyCoRep for what
-  the visibility flag means.
+- See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility] in TyCoRep
+  for what the visibility flag means.
 
 * Each TyConBinder tyConBinders has a TyVar, and that TyVar may
   scope over some other part of the TyCon's definition. Eg
@@ -874,7 +943,8 @@ data AlgTyConFlav
           -- use the tyConTyVars of this TyCon
         TyCon   -- The family TyCon
         [Type]  -- Argument types (mentions the tyConTyVars of this TyCon)
-                -- Match in length the tyConTyVars of the family TyCon
+                -- No shorter in length than the tyConTyVars of the family TyCon
+                -- How could it be longer? See [Arity of data families] in FamInstEnv
 
         -- E.g.  data instance T [a] = ...
         -- gives a representation tycon:
@@ -895,7 +965,7 @@ okParent :: Name -> AlgTyConFlav -> Bool
 okParent _       (VanillaAlgTyCon {})            = True
 okParent _       (UnboxedAlgTyCon {})            = True
 okParent tc_name (ClassTyCon cls _)              = tc_name == tyConName (classTyCon cls)
-okParent _       (DataFamInstTyCon _ fam_tc tys) = tys `lengthIs` tyConArity fam_tc
+okParent _       (DataFamInstTyCon _ fam_tc tys) = tys `lengthAtLeast` tyConArity fam_tc
 
 isNoParent :: AlgTyConFlav -> Bool
 isNoParent (VanillaAlgTyCon {}) = True
@@ -2038,6 +2108,10 @@ expandSynTyCon_maybe tc tys
 -- | Check if the tycon actually refers to a proper `data` or `newtype`
 --  with user defined constructors rather than one from a class or other
 --  construction.
+
+-- NB: This is only used in TcRnExports.checkPatSynParent to determine if an
+-- exported tycon can have a pattern synonym bundled with it, e.g.,
+-- module Foo (TyCon(.., PatSyn)) where
 isTyConWithSrcDataCons :: TyCon -> Bool
 isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =
   case rhs of
@@ -2047,6 +2121,8 @@ isTyConWithSrcDataCons (AlgTyCon { algTcRhs = rhs, algTcParent = parent }) =
     _ -> False
   where
     isSrcParent = isNoParent parent
+isTyConWithSrcDataCons (FamilyTyCon { famTcFlav = DataFamilyTyCon {} })
+                         = True -- #14058
 isTyConWithSrcDataCons _ = False
 
 
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index 8621e6cd52..f43e0e0b56 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -110,7 +110,7 @@ module Type (
 
         -- (Lifting and boxity)
         isLiftedType_maybe, isUnliftedType, isUnboxedTupleType, isUnboxedSumType,
-        isAlgType, isClosedAlgType, isDataFamilyAppType,
+        isAlgType, isDataFamilyAppType,
         isPrimitiveType, isStrictType,
         isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
         dropRuntimeRepArgs,
@@ -166,7 +166,7 @@ module Type (
         zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
         extendTCvSubst, extendCvSubst,
-        extendTvSubst, extendTvSubstBinder,
+        extendTvSubst, extendTvSubstBinderAndInScope,
         extendTvSubstList, extendTvSubstAndInScope,
         extendTvSubstWithClone,
         isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
@@ -615,8 +615,8 @@ getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
                   | otherwise               = repGetTyVar_maybe ty
 
 -- | If the type is a tyvar, possibly under a cast, returns it, along
--- with the coercion. Thus, the co is :: kind tv ~R kind type
-getCastedTyVar_maybe :: Type -> Maybe (TyVar, Coercion)
+-- with the coercion. Thus, the co is :: kind tv ~N kind type
+getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
 getCastedTyVar_maybe ty | Just ty' <- coreView ty = getCastedTyVar_maybe ty'
 getCastedTyVar_maybe (CastTy (TyVarTy tv) co)     = Just (tv, co)
 getCastedTyVar_maybe (TyVarTy tv)
@@ -789,7 +789,7 @@ splitAppTys ty = split ty ty []
     split orig_ty _                     args  = (orig_ty, args)
 
 -- | Like 'splitAppTys', but doesn't look through type synonyms
-repSplitAppTys :: Type -> (Type, [Type])
+repSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type])
 repSplitAppTys ty = split ty []
   where
     split (AppTy ty arg) args = split ty (arg:args)
@@ -943,7 +943,7 @@ funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
 funArgTy (FunTy arg _res) = arg
 funArgTy ty               = pprPanic "funArgTy" (ppr ty)
 
-piResultTy :: Type -> Type ->  Type
+piResultTy :: HasDebugCallStack => Type -> Type ->  Type
 piResultTy ty arg = case piResultTy_maybe ty arg of
                       Just res -> res
                       Nothing  -> pprPanic "piResultTy" (ppr ty $$ ppr arg)
@@ -988,7 +988,7 @@ piResultTy_maybe ty arg
 -- so we pay attention to efficiency, especially in the special case
 -- where there are no for-alls so we are just dropping arrows from
 -- a function type/kind.
-piResultTys :: Type -> [Type] -> Type
+piResultTys :: HasDebugCallStack => Type -> [Type] -> Type
 piResultTys ty [] = ty
 piResultTys ty orig_args@(arg:args)
   | Just ty' <- coreView ty
@@ -1315,8 +1315,12 @@ mkLamType v ty
 
 mkLamTypes vs ty = foldr mkLamType ty vs
 
--- | Given a list of type-level vars and a result type, makes TyBinders, preferring
--- anonymous binders if the variable is, in fact, not dependent.
+-- | Given a list of type-level vars and a result kind,
+-- makes TyBinders, preferring anonymous binders
+-- if the variable is, in fact, not dependent.
+-- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)
+-- We want (k:*) Named, (a;k) Anon, (c:k) Anon
+--
 -- All binders are /visible/.
 mkTyConBindersPreferAnon :: [TyVar] -> Type -> [TyConBinder]
 mkTyConBindersPreferAnon vars inner_ty = fst (go vars)
@@ -1486,14 +1490,6 @@ isTauTy (CoercionTy _)        = False  -- Not sure about this
 %************************************************************************
 -}
 
--- | Make a named binder
-mkTyVarBinder :: ArgFlag -> Var -> TyVarBinder
-mkTyVarBinder vis var = TvBndr var vis
-
--- | Make many named binders
-mkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]
-mkTyVarBinders vis = map (mkTyVarBinder vis)
-
 -- | Make an anonymous binder
 mkAnonBinder :: Type -> TyBinder
 mkAnonBinder = Anon
@@ -1836,7 +1832,7 @@ predTypeEqRel ty
 --
 -- This is a deterministic sorting operation
 -- (that is, doesn't depend on Uniques).
-toposortTyVars :: [TyVar] -> [TyVar]
+toposortTyVars :: [TyCoVar] -> [TyCoVar]
 toposortTyVars tvs = reverse $
                      [ node_payload node | node <- topologicalSortG $
                                           graphFromEdgedVerticesOrd nodes ]
@@ -2023,17 +2019,6 @@ isAlgType ty
                             isAlgTyCon tc
       _other             -> False
 
--- | See "Type#type_classification" for what an algebraic type is.
--- Should only be applied to /types/, as opposed to e.g. partially
--- saturated type constructors. Closed type constructors are those
--- with a fixed right hand side, as opposed to e.g. associated types
-isClosedAlgType :: Type -> Bool
-isClosedAlgType ty
-  = case splitTyConApp_maybe ty of
-      Just (tc, ty_args) | isAlgTyCon tc && not (isFamilyTyCon tc)
-             -> ASSERT2( ty_args `lengthIs` tyConArity tc, ppr ty ) True
-      _other -> False
-
 -- | Check whether a type is a data family type
 isDataFamilyAppType :: Type -> Bool
 isDataFamilyAppType ty = case tyConAppTyCon_maybe ty of
diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot
index 2fc251acb7..002db72cf1 100644
--- a/compiler/types/Type.hs-boot
+++ b/compiler/types/Type.hs-boot
@@ -2,7 +2,7 @@
 
 module Type where
 import TyCon
-import Var ( TyVar )
+import Var ( TyCoVar )
 import {-# SOURCE #-} TyCoRep( Type, Coercion, Kind )
 import Util
 
@@ -11,7 +11,7 @@ isCoercionTy :: Type -> Bool
 
 mkAppTy :: Type -> Type -> Type
 mkCastTy :: Type -> Coercion -> Type
-piResultTy :: Type -> Type -> Type
+piResultTy :: HasDebugCallStack => Type -> Type -> Type
 
 typeKind :: Type -> Kind
 eqType :: Type -> Type -> Bool
@@ -21,6 +21,7 @@ partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
 coreView :: Type -> Maybe Type
 tcView :: Type -> Maybe Type
 
-tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]
-tyCoVarsOfTypeWellScoped :: Type -> [TyVar]
+tyCoVarsOfTypesWellScoped :: [Type] -> [TyCoVar]
+tyCoVarsOfTypeWellScoped :: Type -> [TyCoVar]
+toposortTyVars :: [TyCoVar] -> [TyCoVar]
 splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 79d0897a14..c9c78f7d19 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -42,9 +42,7 @@ import UniqFM
 import UniqSet
 
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 import Control.Applicative hiding ( empty )
 import qualified Control.Applicative
 
@@ -1050,10 +1048,8 @@ instance Alternative UM where
 
 instance MonadPlus UM
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail UM where
     fail _   = UM (\_ -> SurelyApart) -- failed pattern match
-#endif
 
 initUM :: TvSubstEnv  -- subst to extend
        -> CvSubstEnv
diff --git a/compiler/utils/IOEnv.hs b/compiler/utils/IOEnv.hs
index 29854c51fe..5a7ccd9972 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/utils/IOEnv.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 --
 -- (c) The University of Glasgow 2002-2006
 --
@@ -41,9 +39,7 @@ import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import System.IO        ( fixIO )
 import Control.Monad
-#if __GLASGOW_HASKELL__ > 710
 import qualified Control.Monad.Fail as MonadFail
-#endif
 import MonadUtils
 import Control.Applicative (Alternative(..))
 
@@ -62,11 +58,8 @@ instance Monad (IOEnv m) where
     (>>)   = (*>)
     fail _ = failM -- Ignore the string
 
-#if __GLASGOW_HASKELL__ > 710
 instance MonadFail.MonadFail (IOEnv m) where
     fail _ = failM -- Ignore the string
-#endif
-
 
 instance Applicative (IOEnv m) where
     pure = returnM
diff --git a/compiler/utils/Json.hs b/compiler/utils/Json.hs
index 1318ce2611..ffbff50641 100644
--- a/compiler/utils/Json.hs
+++ b/compiler/utils/Json.hs
@@ -39,7 +39,7 @@ escapeJsonString = concatMap escapeChar
     escapeChar '\n' = "\\n"
     escapeChar '\r' = "\\r"
     escapeChar '\t' = "\\t"
-    escapeChar '"'  = "\""
+    escapeChar '"'  = "\\\""
     escapeChar '\\'  = "\\\\"
     escapeChar c | isControl c || fromEnum c >= 0x7f  = uni_esc c
     escapeChar c = [c]
diff --git a/compiler/utils/ListSetOps.hs b/compiler/utils/ListSetOps.hs
index f1aa2c3755..7fa441402c 100644
--- a/compiler/utils/ListSetOps.hs
+++ b/compiler/utils/ListSetOps.hs
@@ -27,6 +27,8 @@ import Outputable
 import Util
 
 import Data.List
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Set as S
 
 getNth :: Outputable a => [a] -> Int -> a
@@ -131,19 +133,19 @@ hasNoDups xs = f [] xs
 
 equivClasses :: (a -> a -> Ordering) -- Comparison
              -> [a]
-             -> [[a]]
+             -> [NonEmpty a]
 
-equivClasses _         []  = []
-equivClasses _   stuff@[_] = [stuff]
-equivClasses cmp items     = groupBy eq (sortBy cmp items)
+equivClasses _   []      = []
+equivClasses _   [stuff] = [stuff :| []]
+equivClasses cmp items   = NE.groupBy eq (sortBy cmp items)
   where
     eq a b = case cmp a b of { EQ -> True; _ -> False }
 
 removeDups :: (a -> a -> Ordering) -- Comparison function
            -> [a]
-           -> ([a],     -- List with no duplicates
-               [[a]])   -- List of duplicate groups.  One representative from
-                        -- each group appears in the first result
+           -> ([a],          -- List with no duplicates
+               [NonEmpty a]) -- List of duplicate groups.  One representative
+                             -- from each group appears in the first result
 
 removeDups _   []  = ([], [])
 removeDups _   [x] = ([x],[])
@@ -151,12 +153,12 @@ removeDups cmp xs
   = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
     (xs', dups) }
   where
-    collect_dups _           []         = panic "ListSetOps: removeDups"
-    collect_dups dups_so_far [x]        = (dups_so_far,      x)
-    collect_dups dups_so_far dups@(x:_) = (dups:dups_so_far, x)
+    collect_dups :: [NonEmpty a] -> NonEmpty a -> ([NonEmpty a], a)
+    collect_dups dups_so_far (x :| [])     = (dups_so_far,      x)
+    collect_dups dups_so_far dups@(x :| _) = (dups:dups_so_far, x)
 
-findDupsEq :: (a->a->Bool) -> [a] -> [[a]]
+findDupsEq :: (a->a->Bool) -> [a] -> [NonEmpty a]
 findDupsEq _  [] = []
 findDupsEq eq (x:xs) | null eq_xs  = findDupsEq eq xs
-                     | otherwise   = (x:eq_xs) : findDupsEq eq neq_xs
+                     | otherwise   = (x :| eq_xs) : findDupsEq eq neq_xs
     where (eq_xs, neq_xs) = partition (eq x) xs
diff --git a/compiler/utils/MonadUtils.hs b/compiler/utils/MonadUtils.hs
index 93a835e04e..d6fb31731e 100644
--- a/compiler/utils/MonadUtils.hs
+++ b/compiler/utils/MonadUtils.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE CPP #-}
-
 -- | Utilities related to Monad and Applicative classes
 --   Mostly for backwards compatibility.
 
@@ -34,9 +32,6 @@ import Maybes
 import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.IO.Class
-#if __GLASGOW_HASKELL__ < 800
-import Control.Monad.Trans.Error () -- for orphan `instance MonadPlus IO`
-#endif
 
 -------------------------------------------------------------------------------
 -- Lift combinators
diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs
index 3c5b9d7380..1660090ba7 100644
--- a/compiler/utils/OrdList.hs
+++ b/compiler/utils/OrdList.hs
@@ -9,7 +9,6 @@ Provide trees (of instructions), so that lists of instructions
 can be appended in linear time.
 -}
 
-{-# LANGUAGE CPP #-}
 module OrdList (
         OrdList,
         nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,
@@ -18,10 +17,8 @@ module OrdList (
 
 import Outputable
 
-#if __GLASGOW_HASKELL__ > 710
 import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
-#endif
 
 infixl 5  `appOL`
 infixl 5  `snocOL`
@@ -39,10 +36,8 @@ data OrdList a
 instance Outputable a => Outputable (OrdList a) where
   ppr ol = ppr (fromOL ol)  -- Convert to list and print that
 
-#if __GLASGOW_HASKELL__ > 710
 instance Semigroup (OrdList a) where
   (<>) = appOL
-#endif
 
 instance Monoid (OrdList a) where
   mempty = nilOL
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index 4107e5beef..bc46f2f472 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP, ImplicitParams #-}
 {-
 (c) The University of Glasgow 2006-2012
 (c) The GRASP Project, Glasgow University, 1992-1998
@@ -122,6 +121,7 @@ import Data.List (intersperse)
 
 import GHC.Fingerprint
 import GHC.Show         ( showMultiLineString )
+import GHC.Stack        ( callStack, prettyCallStack )
 
 {-
 ************************************************************************
@@ -1130,7 +1130,8 @@ doOrDoes _   = text "do"
 
 callStackDoc :: HasCallStack => SDoc
 callStackDoc =
-    hang (text "Call stack:") 4 (vcat $ map text $ lines prettyCurrentCallStack)
+    hang (text "Call stack:")
+       4 (vcat $ map text $ lines (prettyCallStack callStack))
 
 pprPanic :: HasCallStack => String -> SDoc -> a
 -- ^ Throw an exception saying "bug in GHC"
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 71a092b28e..8ea8ba4537 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -85,10 +85,8 @@ import qualified Data.Monoid as Mon
 import qualified Data.IntSet as S
 import Data.Typeable
 import Data.Data
-#if __GLASGOW_HASKELL__ > 710
 import Data.Semigroup   ( Semigroup )
 import qualified Data.Semigroup as Semigroup
-#endif
 
 
 newtype UniqFM ele = UFM (M.IntMap ele)
@@ -358,10 +356,8 @@ equalKeysUFM (UFM m1) (UFM m2) = M.keys m1 == M.keys m2
 
 -- Instances
 
-#if __GLASGOW_HASKELL__ > 710
 instance Semigroup (UniqFM a) where
   (<>) = plusUFM
-#endif
 
 instance Monoid (UniqFM a) where
     mempty = emptyUFM
diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs
index f29a1e6e1f..fcac865ea8 100644
--- a/compiler/utils/UniqSet.hs
+++ b/compiler/utils/UniqSet.hs
@@ -9,7 +9,6 @@ Based on @UniqFMs@ (as you would expect).
 Basically, the things need to be in class @Uniquable@.
 -}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 module UniqSet (
@@ -53,9 +52,7 @@ import Data.Coerce
 import Outputable
 import Data.Foldable (foldl')
 import Data.Data
-#if __GLASGOW_HASKELL__ >= 801
 import qualified Data.Semigroup
-#endif
 
 -- Note [UniqSet invariant]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -189,10 +186,8 @@ unsafeUFMToUniqSet = UniqSet
 
 instance Outputable a => Outputable (UniqSet a) where
     ppr = pprUniqSet ppr
-#if __GLASGOW_HASKELL__ >= 801
 instance Data.Semigroup.Semigroup (UniqSet a) where
   (<>) = mappend
-#endif
 instance Monoid (UniqSet a) where
   mempty = UniqSet mempty
   UniqSet s `mappend` UniqSet t = UniqSet (s `mappend` t)
diff --git a/compiler/utils/Util.hs b/compiler/utils/Util.hs
index 35a6340fd4..6146bf0113 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/utils/Util.hs
@@ -4,11 +4,6 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE BangPatterns #-}
-#if __GLASGOW_HASKELL__ < 800
--- For CallStack business
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE FlexibleContexts #-}
-#endif
 
 -- | Highly random utility functions
 --
@@ -124,12 +119,8 @@ module Util (
         hashString,
 
         -- * Call stacks
-#if MIN_VERSION_GLASGOW_HASKELL(7,10,2,0)
-        GHC.Stack.CallStack,
-#endif
         HasCallStack,
         HasDebugCallStack,
-        prettyCurrentCallStack,
 
         -- * Utils for flags
         OverridingBool(..),
@@ -147,7 +138,7 @@ import System.IO.Unsafe ( unsafePerformIO )
 import Data.List        hiding (group)
 
 import GHC.Exts
-import qualified GHC.Stack
+import GHC.Stack (HasCallStack)
 
 import Control.Applicative ( liftA2 )
 import Control.Monad    ( liftM )
@@ -1368,16 +1359,6 @@ mulHi a b = fromIntegral (r `shiftR` 32)
    where r :: Int64
          r = fromIntegral a * fromIntegral b
 
--- | A compatibility wrapper for the @GHC.Stack.HasCallStack@ constraint.
-#if __GLASGOW_HASKELL__ >= 800
-type HasCallStack = GHC.Stack.HasCallStack
-#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0)
-type HasCallStack = (?callStack :: GHC.Stack.CallStack)
--- CallStack wasn't present in GHC 7.10.1, disable callstacks in stage 1
-#else
-type HasCallStack = (() :: Constraint)
-#endif
-
 -- | A call stack constraint, but only when 'isDebugOn'.
 #if defined(DEBUG)
 type HasDebugCallStack = HasCallStack
@@ -1385,18 +1366,6 @@ type HasDebugCallStack = HasCallStack
 type HasDebugCallStack = (() :: Constraint)
 #endif
 
--- | Pretty-print the current callstack
-#if __GLASGOW_HASKELL__ >= 800
-prettyCurrentCallStack :: HasCallStack => String
-prettyCurrentCallStack = GHC.Stack.prettyCallStack GHC.Stack.callStack
-#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0)
-prettyCurrentCallStack :: (?callStack :: GHC.Stack.CallStack) => String
-prettyCurrentCallStack = GHC.Stack.showCallStack ?callStack
-#else
-prettyCurrentCallStack :: HasCallStack => String
-prettyCurrentCallStack = "Call stack unavailable"
-#endif
-
 data OverridingBool
   = Auto
   | Always
diff --git a/configure.ac b/configure.ac
index 00fae0aad0..c11910ea85 100644
--- a/configure.ac
+++ b/configure.ac
@@ -158,8 +158,8 @@ if test "$WithGhc" = ""
 then
     AC_MSG_ERROR([GHC is required.])
 fi
-FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[7.10],
-    [AC_MSG_ERROR([GHC version 7.10 or later is required to compile GHC.])])
+FP_COMPARE_VERSIONS([$GhcVersion],[-lt],[8.0],
+    [AC_MSG_ERROR([GHC version 8.0 or later is required to compile GHC.])])
 
 if test `expr $GhcMinVersion % 2` = "1"
 then
diff --git a/docs/core-spec/CoreSyn.ott b/docs/core-spec/CoreSyn.ott
index 578d200b6b..c42e38a980 100644
--- a/docs/core-spec/CoreSyn.ott
+++ b/docs/core-spec/CoreSyn.ott
@@ -318,7 +318,7 @@ terminals :: 'terminals_' ::=
   | no_duplicates ::  :: no_duplicates    {{ tex \textsf{no\_duplicates } }}
   | vars_of      ::   :: vars_of          {{ tex \textsf{vars\_of } }}
   | not          ::   :: not              {{ tex \neg }}
-  | isUnLiftedTyCon :: :: isUnLiftenTyCon {{ tex \textsf{isUnLiftedTyCon} }}
+  | isUnLiftedTyCon :: :: isUnLiftedTyCon {{ tex \textsf{isUnLiftedTyCon} }}
   | compatibleUnBoxedTys :: :: compatibleUnBoxedTys {{ tex \textsf{compatibleUnBoxedTys} }}
   | false        ::   :: false            {{ tex \textsf{false} }}
   | true         ::   :: true             {{ tex \textsf{true} }}
diff --git a/docs/users_guide/8.4.1-notes.rst b/docs/users_guide/8.4.1-notes.rst
index 9b9d79ffd4..d3cef24c57 100644
--- a/docs/users_guide/8.4.1-notes.rst
+++ b/docs/users_guide/8.4.1-notes.rst
@@ -21,6 +21,12 @@ Full details
 Language
 ~~~~~~~~
 
+- Data families have been generalised a bit: a data family declaration can now
+  end with a kind variable ``k`` instead of ``Type``. Additionally, data/newtype
+  instance no longer need to list all the patterns of the family if they don't
+  wish to; this is quite like how regular datatypes with a kind signature can omit
+  some type variables.
+
 Compiler
 ~~~~~~~~
 
@@ -140,3 +146,9 @@ Template Haskell
       #endif
 
   can be used.
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- Blank strings can now be used as values for environment variables using the
+  System.Environment.Blank module. See :ghc-ticket:`12494`
diff --git a/docs/users_guide/ffi-chap.rst b/docs/users_guide/ffi-chap.rst
index 311146c4d9..320a3a6e70 100644
--- a/docs/users_guide/ffi-chap.rst
+++ b/docs/users_guide/ffi-chap.rst
@@ -337,6 +337,12 @@ reliably re-initialise after this has happened; see :ref:`infelicities-ffi`.
     don't forget the flag :ghc-flag:`-no-hs-main`, otherwise GHC
     will try to link to the ``Main`` Haskell module.
 
+.. note::
+    On Windows hs_init treats argv as UTF8-encoded. Passing other encodings
+    might lead to unexpected results. Passing NULL as argv is valid but can
+    lead to <unknown> showing up in error messages instead of the name of the
+    executable.
+
 To use ``+RTS`` flags with ``hs_init()``, we have to modify the example
 slightly. By default, GHC's RTS will only accept "safe" ``+RTS`` flags (see
 :ref:`options-linker`), and the :ghc-flag:`-rtsopts[=⟨none|some|all⟩]`
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index a2cc0ba269..bc09402668 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -1701,8 +1701,8 @@ example, consider these two candidate definitions of ``absurd``:
 
 ::
 
-    data a :==: b where
-      Refl :: a :==: a
+    data a :~: b where
+      Refl :: a :~: a
 
     absurd :: True :~: False -> a
     absurd x = error "absurd"    -- (A)
@@ -1710,10 +1710,9 @@ example, consider these two candidate definitions of ``absurd``:
 
 We much prefer (B). Why? Because GHC can figure out that
 ``(True :~: False)`` is an empty type. So (B) has no partiality and GHC
-should be able to compile with :ghc-flag:`-Wincomplete-patterns`. (Though
-the pattern match checking is not yet clever enough to do that.) On the
-other hand (A) looks dangerous, and GHC doesn't check to make sure that,
-in fact, the function can never get called.
+is able to compile with :ghc-flag:`-Wincomplete-patterns` and
+:ghc-flag:`-Werror`. On the other hand (A) looks dangerous, and GHC doesn't
+check to make sure that, in fact, the function can never get called.
 
 .. _multi-way-if:
 
@@ -6772,6 +6771,11 @@ entirely optional, so that we can declare ``Array`` alternatively with ::
 
     data family Array :: * -> *
 
+Unlike with ordinary data definitions, the result kind of a data family
+does not need to be ``*``: it can alternatively be a kind variable
+(with :ghc-flag:`-XPolyKinds`). Data instances' kinds must end in
+``*``, however.
+    
 .. _data-instance-declarations:
 
 Data instance declarations
@@ -8347,9 +8351,9 @@ enabled).
 The only way ``*`` is unordinary is in its parsing. In order to be backward
 compatible, ``*`` is parsed as if it were an alphanumeric idenfifier; note
 that we do not write ``Int :: (*)`` but just plain ``Int :: *``. Due to the
-bizarreness with which ``*`` is parsed-and the fact that it is the only such
-operator in GHC-there are some corner cases that are
-not handled. We are aware of two:
+bizarreness with which ``*`` is parsed--and the fact that it is the only such
+operator in GHC--there are some corner cases that are
+not handled. We are aware of three:
 
 - In a Haskell-98-style data constructor, you must put parentheses around
   ``*``, like this: ::
@@ -8363,6 +8367,10 @@ not handled. We are aware of two:
   Note that the keyword ``type`` there is just to disambiguate the import
   from a term-level ``(*)``. (:ref:`explicit-namespaces`)
 
+- In an instance declaration head (the part after the word ``instance``), you
+  must parenthesize ``*``. This applies to all manners of instances, including
+  the left-hand sides of individual equations of a closed type family.
+
 The ``Data.Kind`` module also exports ``Type`` as a synonym for ``*``.
 Now that type synonyms work in kinds, it is conceivable that we will deprecate
 ``*`` when there is a good migration story for everyone to use ``Type``.
@@ -10286,6 +10294,10 @@ warnings instead of errors. Additionally, these warnings can be silenced
 with the :ghc-flag:`-Wno-partial-type-signatures <-Wpartial-type-signatures>`
 flag.
 
+However, because GHC must *infer* the type when part of a type is left
+out, it is unable to use polymorphic recursion. The same restriction
+takes place when the type signature is omitted completely.
+
 .. _pts-syntax:
 
 Syntax
diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst
index cefaa8a6d1..074b9499f5 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -740,6 +740,15 @@ for example).
         an error message. If the ``GHCRTS`` environment variable is set,
         then the program will emit a warning message, ``GHCRTS`` will be
         ignored, and the program will run as normal.
+    
+    ``-rtsopts=ignore``
+        Disables all processing of RTS options. Unlike ``none`` this treats
+        all RTS flags appearing on the command line the same way as regular
+        arguments. (Passing them on to your program as arguments).
+        ``GHCRTS`` options will be processed normally.
+
+    ``-rtsopts=ignoreAll``
+        Same as ``ignore`` but also ignores ``GHCRTS``.
 
     ``-rtsopts=some``
         [this is the default setting] Enable only the "safe" RTS
diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst
index 422eaa2ceb..f141c323f6 100644
--- a/docs/users_guide/runtime_control.rst
+++ b/docs/users_guide/runtime_control.rst
@@ -117,8 +117,8 @@ Setting RTS options with the ``GHCRTS`` environment variable
 
 .. envvar:: GHCRTS
 
-    If the ``-rtsopts`` flag is set to something other than ``none`` when
-    linking, RTS options are also taken from the environment variable
+    If the ``-rtsopts`` flag is set to something other than ``none`` or ``ignoreAll``
+    when linking, RTS options are also taken from the environment variable
     :envvar:`GHCRTS`. For example, to set the maximum heap size to 2G
     for all GHC-compiled programs (using an ``sh``\-like shell):
 
diff --git a/ghc.mk b/ghc.mk
index 4eb1658174..55cc1197c5 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -430,7 +430,7 @@ else # CLEANING
 # programs such as GHC and ghc-pkg, that we do not assume the stage0
 # compiler already has installed (or up-to-date enough).
 
-PACKAGES_STAGE0 = binary Cabal/Cabal hpc ghc-boot-th ghc-boot transformers template-haskell ghci
+PACKAGES_STAGE0 = binary text transformers mtl parsec Cabal/Cabal hpc ghc-boot-th ghc-boot template-haskell ghci
 ifeq "$(Windows_Host)" "NO"
 PACKAGES_STAGE0 += terminfo
 endif
@@ -457,11 +457,17 @@ PACKAGES_STAGE1 += process
 PACKAGES_STAGE1 += hpc
 PACKAGES_STAGE1 += pretty
 PACKAGES_STAGE1 += binary
+PACKAGES_STAGE1 += text
+PACKAGES_STAGE1 += transformers
+PACKAGES_STAGE1 += mtl
+PACKAGES_STAGE1 += parsec
+# temporary until Cabal switches to parsec mode by default
+libraries/Cabal/Cabal_dist-boot_CONFIGURE_OPTS += --flag parsec
+libraries/Cabal/Cabal_dist-install_CONFIGURE_OPTS += --flag parsec
 PACKAGES_STAGE1 += Cabal/Cabal
 PACKAGES_STAGE1 += ghc-boot-th
 PACKAGES_STAGE1 += ghc-boot
 PACKAGES_STAGE1 += template-haskell
-PACKAGES_STAGE1 += transformers
 PACKAGES_STAGE1 += ghc-compact
 
 ifeq "$(HADDOCK_DOCS)" "YES"
@@ -1264,6 +1270,7 @@ $(eval $(call sdist-ghc-file,compiler,stage2,parser,Parser,y))
 $(eval $(call sdist-ghc-file,utils/hpc,dist-install,,HpcParser,y))
 $(eval $(call sdist-ghc-file,utils/genprimopcode,dist,,Lexer,x))
 $(eval $(call sdist-ghc-file,utils/genprimopcode,dist,,Parser,y))
+$(eval $(call sdist-ghc-file2,libraries/Cabal/Cabal,dist-install,Distribution/Parsec,Lexer,x))
 
 .PHONY: sdist-ghc-prep
 sdist-ghc-prep : sdist-ghc-prep-tree
diff --git a/ghc/hschooks.c b/ghc/hschooks.c
index 031cb02d1a..87feab370a 100644
--- a/ghc/hschooks.c
+++ b/ghc/hschooks.c
@@ -63,11 +63,9 @@ StackOverflowHook (StgWord stack_size)    /* in bytes */
 int main (int argc, char *argv[])
 {
     RtsConfig conf = defaultRtsConfig;
-#if __GLASGOW_HASKELL__ >= 711
     conf.defaultsHook = defaultsHook;
     conf.rts_opts_enabled = RtsOptsAll;
     conf.stackOverflowHook = StackOverflowHook;
-#endif
     extern StgClosure ZCMain_main_closure;
 
     hs_main(argc, argv, &ZCMain_main_closure, conf);
diff --git a/includes/Rts.h b/includes/Rts.h
index aca24e4f28..a59a8ca432 100644
--- a/includes/Rts.h
+++ b/includes/Rts.h
@@ -211,12 +211,6 @@ DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell *
 DLL_IMPORT_RTS extern int    prog_argc;
 DLL_IMPORT_RTS extern char  *prog_name;
 
-#if defined(mingw32_HOST_OS)
-// We need these two from Haskell too
-void getWin32ProgArgv(int *argc, wchar_t **argv[]);
-void setWin32ProgArgv(int argc, wchar_t *argv[]);
-#endif
-
 void reportStackOverflow(StgTSO* tso);
 void reportHeapOverflow(void);
 
diff --git a/includes/RtsAPI.h b/includes/RtsAPI.h
index 1ed5fb06f0..ca61328b7c 100644
--- a/includes/RtsAPI.h
+++ b/includes/RtsAPI.h
@@ -53,6 +53,8 @@ typedef struct CapabilityPublic_ {
 
 typedef enum {
     RtsOptsNone,         // +RTS causes an error
+    RtsOptsIgnore,       // Ignore command line arguments
+    RtsOptsIgnoreAll,    // Ignore command line and Environment arguments
     RtsOptsSafeOnly,     // safe RTS options allowed; others cause an error
     RtsOptsAll           // all RTS options allowed
   } RtsOptsEnabledEnum;
diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 559cceda66..3e531e5b15 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -107,7 +107,7 @@ newtype ZipList a = ZipList { getZipList :: [a] }
 
 -- |
 -- > f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsN
---       = 'ZipList' (zipWithN f xs1 ... xsN)
+-- >     = 'ZipList' (zipWithN f xs1 ... xsN)
 --
 -- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity
 -- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example:
diff --git a/libraries/base/Data/Bits.hs b/libraries/base/Data/Bits.hs
index d12d6dc4bd..da2ea3d18f 100644
--- a/libraries/base/Data/Bits.hs
+++ b/libraries/base/Data/Bits.hs
@@ -57,17 +57,13 @@ module Data.Bits (
 
 #include "MachDeps.h"
 
-#if defined(MIN_VERSION_integer_gmp)
-# define HAVE_INTEGER_GMP1 MIN_VERSION_integer_gmp(1,0,0)
-#endif
-
 import Data.Maybe
 import GHC.Enum
 import GHC.Num
 import GHC.Base
 import GHC.Real
 
-#if HAVE_INTEGER_GMP1
+#if defined(MIN_VERSION_integer_gmp)
 import GHC.Integer.GMP.Internals (bitInteger, popCountInteger)
 #endif
 
@@ -526,7 +522,7 @@ instance Bits Integer where
    testBit x (I# i) = testBitInteger x i
    zeroBits   = 0
 
-#if HAVE_INTEGER_GMP1
+#if defined(MIN_VERSION_integer_gmp)
    bit (I# i#) = bitInteger i#
    popCount x  = I# (popCountInteger x)
 #else
diff --git a/libraries/base/Data/Functor.hs b/libraries/base/Data/Functor.hs
index 62bb70927e..2c0fbc3f29 100644
--- a/libraries/base/Data/Functor.hs
+++ b/libraries/base/Data/Functor.hs
@@ -20,6 +20,7 @@ module Data.Functor
       (<$),
       ($>),
       (<$>),
+      (<&>),
       void,
     ) where
 
@@ -74,6 +75,31 @@ infixl 4 <$>
 
 infixl 4 $>
 
+-- | Flipped version of '<$>'.
+--
+-- @
+-- ('<&>') = 'flip' 'fmap'
+-- @
+--
+-- @since 4.11.0.0
+--
+-- ==== __Examples__
+-- Apply @(+1)@ to a list, a 'Data.Maybe.Just' and a 'Data.Either.Right':
+--
+-- >>> Just 2 <&> (+1)
+-- Just 3
+--
+-- >>> [1,2,3] <&> (+1)
+-- [2,3,4]
+--
+-- >>> Right 3 <&> (+1)
+-- Right 4
+--
+(<&>) :: Functor f => f a -> (a -> b) -> f b
+as <&> f = f <$> as
+
+infixl 1 <&>
+
 -- | Flipped version of '<$'.
 --
 -- @since 4.7.0.0
diff --git a/libraries/base/Data/OldList.hs b/libraries/base/Data/OldList.hs
index bee1b6f98a..d03c0bcc96 100644
--- a/libraries/base/Data/OldList.hs
+++ b/libraries/base/Data/OldList.hs
@@ -228,8 +228,12 @@ infix 5 \\ -- comment to fool cpp: https://www.haskell.org/ghc/docs/latest/html/
 -- | The 'dropWhileEnd' function drops the largest suffix of a list
 -- in which the given predicate holds for all elements.  For example:
 --
--- > dropWhileEnd isSpace "foo\n" == "foo"
--- > dropWhileEnd isSpace "foo bar" == "foo bar"
+-- >>> dropWhileEnd isSpace "foo\n"
+-- "foo"
+--
+-- >>> dropWhileEnd isSpace "foo bar"
+-- "foo bar"
+--
 -- > dropWhileEnd isSpace ("foo\n" ++ undefined) == "foo" ++ undefined
 --
 -- @since 4.5.0.0
@@ -240,10 +244,17 @@ dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
 -- It returns 'Nothing' if the list did not start with the prefix
 -- given, or 'Just' the list after the prefix, if it does.
 --
--- > stripPrefix "foo" "foobar" == Just "bar"
--- > stripPrefix "foo" "foo" == Just ""
--- > stripPrefix "foo" "barfoo" == Nothing
--- > stripPrefix "foo" "barfoobaz" == Nothing
+-- >>> stripPrefix "foo" "foobar"
+-- Just "bar"
+--
+-- >>> stripPrefix "foo" "foo"
+-- Just ""
+--
+-- >>> stripPrefix "foo" "barfoo"
+-- Nothing
+--
+-- >>> stripPrefix "foo" "barfoobaz"
+-- Nothing
 stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
 stripPrefix [] ys = Just ys
 stripPrefix (x:xs) (y:ys)
@@ -253,28 +264,46 @@ stripPrefix _ _ = Nothing
 -- | The 'elemIndex' function returns the index of the first element
 -- in the given list which is equal (by '==') to the query element,
 -- or 'Nothing' if there is no such element.
+--
+-- >>> elemIndex 4 [0..]
+-- Just 4
 elemIndex       :: Eq a => a -> [a] -> Maybe Int
 elemIndex x     = findIndex (x==)
 
 -- | The 'elemIndices' function extends 'elemIndex', by returning the
 -- indices of all elements equal to the query element, in ascending order.
+--
+-- >>> elemIndices 'o' "Hello World"
+-- [4,7]
 elemIndices     :: Eq a => a -> [a] -> [Int]
 elemIndices x   = findIndices (x==)
 
 -- | The 'find' function takes a predicate and a list and returns the
 -- first element in the list matching the predicate, or 'Nothing' if
 -- there is no such element.
+--
+-- >>> find (> 4) [1..]
+-- Just 5
+--
+-- >>> find (< 0) [1..10]
+-- Nothing
 find            :: (a -> Bool) -> [a] -> Maybe a
 find p          = listToMaybe . filter p
 
 -- | The 'findIndex' function takes a predicate and a list and returns
 -- the index of the first element in the list satisfying the predicate,
 -- or 'Nothing' if there is no such element.
+--
+-- >>> findIndex isSpace "Hello World!"
+-- Just 5
 findIndex       :: (a -> Bool) -> [a] -> Maybe Int
 findIndex p     = listToMaybe . findIndices p
 
 -- | The 'findIndices' function extends 'findIndex', by returning the
 -- indices of all elements satisfying the predicate, in ascending order.
+--
+-- >>> findIndices (`elem` "aeiou") "Hello World!"
+-- [1,4,7]
 findIndices      :: (a -> Bool) -> [a] -> [Int]
 #if defined(USE_REPORT_PRELUDE)
 findIndices p xs = [ i | (x,i) <- zip xs [0..], p x]
@@ -289,6 +318,12 @@ findIndices p ls = build $ \c n ->
 
 -- | The 'isPrefixOf' function takes two lists and returns 'True'
 -- iff the first list is a prefix of the second.
+--
+-- >>> "Hello" `isPrefixOf` "Hello World!"
+-- True
+--
+-- >>> "Hello" `isPrefixOf` "Wello Horld!"
+-- False
 isPrefixOf              :: (Eq a) => [a] -> [a] -> Bool
 isPrefixOf [] _         =  True
 isPrefixOf _  []        =  False
@@ -297,6 +332,12 @@ isPrefixOf (x:xs) (y:ys)=  x == y && isPrefixOf xs ys
 -- | The 'isSuffixOf' function takes two lists and returns 'True' iff
 -- the first list is a suffix of the second. The second list must be
 -- finite.
+--
+-- >>> "ld!" `isSuffixOf` "Hello World!"
+-- True
+--
+-- >>> "World" `isSuffixOf` "Hello World!"
+-- False
 isSuffixOf              :: (Eq a) => [a] -> [a] -> Bool
 ns `isSuffixOf` hs      = maybe False id $ do
       delta <- dropLengthMaybe ns hs
@@ -311,6 +352,12 @@ ns `isSuffixOf` hs      = maybe False id $ do
 -- entirety.  dropLength is also generally faster than (drop . length)
 -- Both this and dropLengthMaybe could be written as folds over their first
 -- arguments, but this reduces clarity with no benefit to isSuffixOf.
+--
+-- >>> dropLength "Hello" "Holla world"
+-- " world"
+--
+-- >>> dropLength [1..] [1,2,3]
+-- []
 dropLength :: [a] -> [b] -> [b]
 dropLength [] y = y
 dropLength _ [] = []
@@ -318,6 +365,9 @@ dropLength (_:x') (_:y') = dropLength x' y'
 
 -- A version of dropLength that returns Nothing if the second list runs out of
 -- elements before the first.
+--
+-- >>> dropLengthMaybe [1..] [1,2,3]
+-- Nothing
 dropLengthMaybe :: [a] -> [b] -> Maybe [b]
 dropLengthMaybe [] y = Just y
 dropLengthMaybe _ [] = Nothing
@@ -327,10 +377,11 @@ dropLengthMaybe (_:x') (_:y') = dropLengthMaybe x' y'
 -- iff the first list is contained, wholly and intact,
 -- anywhere within the second.
 --
--- Example:
+-- >>> isInfixOf "Haskell" "I really like Haskell."
+-- True
 --
--- >isInfixOf "Haskell" "I really like Haskell." == True
--- >isInfixOf "Ial" "I really like Haskell." == False
+-- >>> isInfixOf "Ial" "I really like Haskell."
+-- False
 isInfixOf               :: (Eq a) => [a] -> [a] -> Bool
 isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 
@@ -339,12 +390,18 @@ isInfixOf needle haystack = any (isPrefixOf needle) (tails haystack)
 -- (The name 'nub' means \`essence\'.)
 -- It is a special case of 'nubBy', which allows the programmer to supply
 -- their own equality test.
+--
+-- >>> nub [1,2,3,4,3,2,1,2,4,3,5]
+-- [1,2,3,4,5]
 nub                     :: (Eq a) => [a] -> [a]
 nub                     =  nubBy (==)
 
 -- | The 'nubBy' function behaves just like 'nub', except it uses a
 -- user-supplied equality predicate instead of the overloaded '=='
 -- function.
+--
+-- >>> nubBy (\x y -> mod x 3 == mod y 3) [1,2,4,5,6]
+-- [1,2,6]
 nubBy                   :: (a -> a -> Bool) -> [a] -> [a]
 #if defined(USE_REPORT_PRELUDE)
 nubBy eq []             =  []
@@ -374,16 +431,19 @@ elem_by eq y (x:xs)     =  x `eq` y || elem_by eq y xs
 -- | 'delete' @x@ removes the first occurrence of @x@ from its list argument.
 -- For example,
 --
--- > delete 'a' "banana" == "bnana"
+-- >>> delete 'a' "banana"
+-- "bnana"
 --
 -- It is a special case of 'deleteBy', which allows the programmer to
 -- supply their own equality test.
-
 delete                  :: (Eq a) => a -> [a] -> [a]
 delete                  =  deleteBy (==)
 
 -- | The 'deleteBy' function behaves like 'delete', but takes a
 -- user-supplied equality predicate.
+--
+-- >>> deleteBy (<=) 4 [1..10]
+-- [1,2,3,5,6,7,8,9,10]
 deleteBy                :: (a -> a -> Bool) -> a -> [a] -> [a]
 deleteBy _  _ []        = []
 deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
@@ -394,6 +454,9 @@ deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
 --
 -- > (xs ++ ys) \\ xs == ys.
 --
+-- >>> "Hello World!" \\ "ell W"
+-- "Hoorld!"
+--
 -- It is a special case of 'deleteFirstsBy', which allows the programmer
 -- to supply their own equality test.
 
@@ -403,7 +466,8 @@ deleteBy eq x (y:ys)    = if x `eq` y then ys else y : deleteBy eq x ys
 -- | The 'union' function returns the list union of the two lists.
 -- For example,
 --
--- > "dog" `union` "cow" == "dogcw"
+-- >>> "dog" `union` "cow"
+-- "dogcw"
 --
 -- Duplicates, and elements of the first list, are removed from the
 -- the second list, but if the first list contains duplicates, so will
@@ -421,11 +485,13 @@ unionBy eq xs ys        =  xs ++ foldl (flip (deleteBy eq)) (nubBy eq ys) xs
 -- | The 'intersect' function takes the list intersection of two lists.
 -- For example,
 --
--- > [1,2,3,4] `intersect` [2,4,6,8] == [2,4]
+-- >>> [1,2,3,4] `intersect` [2,4,6,8]
+-- [2,4]
 --
 -- If the first list contains duplicates, so will the result.
 --
--- > [1,2,2,3,4] `intersect` [6,4,4,2] == [2,2,4]
+-- >>> [1,2,2,3,4] `intersect` [6,4,4,2]
+-- [2,2,4]
 --
 -- It is a special case of 'intersectBy', which allows the programmer to
 -- supply their own equality test. If the element is found in both the first
@@ -444,8 +510,8 @@ intersectBy eq xs ys    =  [x | x <- xs, any (eq x) ys]
 -- \`intersperses\' that element between the elements of the list.
 -- For example,
 --
--- > intersperse ',' "abcde" == "a,b,c,d,e"
-
+-- >>> intersperse ',' "abcde"
+-- "a,b,c,d,e"
 intersperse             :: a -> [a] -> [a]
 intersperse _   []      = []
 intersperse sep (x:xs)  = x : prependToAll sep xs
@@ -462,18 +528,22 @@ prependToAll sep (x:xs) = sep : x : prependToAll sep xs
 -- | 'intercalate' @xs xss@ is equivalent to @('concat' ('intersperse' xs xss))@.
 -- It inserts the list @xs@ in between the lists in @xss@ and concatenates the
 -- result.
+--
+-- >>> intercalate ", " ["Lorem", "ipsum", "dolor"]
+-- "Lorem, ipsum, dolor"
 intercalate :: [a] -> [[a]] -> [a]
 intercalate xs xss = concat (intersperse xs xss)
 
 -- | The 'transpose' function transposes the rows and columns of its argument.
 -- For example,
 --
--- > transpose [[1,2,3],[4,5,6]] == [[1,4],[2,5],[3,6]]
+-- >>> transpose [[1,2,3],[4,5,6]]
+-- [[1,4],[2,5],[3,6]]
 --
 -- If some of the rows are shorter than the following rows, their elements are skipped:
 --
--- > transpose [[10,11],[20],[],[30,31,32]] == [[10,20,30],[11,31],[32]]
-
+-- >>> transpose [[10,11],[20],[],[30,31,32]]
+-- [[10,20,30],[11,31],[32]]
 transpose               :: [[a]] -> [[a]]
 transpose []             = []
 transpose ([]   : xss)   = transpose xss
@@ -485,7 +555,9 @@ transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t
 -- predicate, respectively; i.e.,
 --
 -- > partition p xs == (filter p xs, filter (not . p) xs)
-
+--
+-- >>> partition (`elem` "aeiou") "Hello World!"
+-- ("eoo","Hll Wrld!")
 partition               :: (a -> Bool) -> [a] -> ([a],[a])
 {-# INLINE partition #-}
 partition p xs = foldr (select p) ([],[]) xs
@@ -549,6 +621,9 @@ mapAccumR f s (x:xs)    =  (s'', y:ys)
 -- is sorted before the call, the result will also be sorted.
 -- It is a special case of 'insertBy', which allows the programmer to
 -- supply their own comparison function.
+--
+-- >>> insert 4 [1,2,3,5,6,7]
+-- [1,2,3,4,5,6,7]
 insert :: Ord a => a -> [a] -> [a]
 insert e ls = insertBy (compare) e ls
 
@@ -563,6 +638,11 @@ insertBy cmp x ys@(y:ys')
 -- | The 'maximumBy' function takes a comparison function and a list
 -- and returns the greatest element of the list by the comparison function.
 -- The list must be finite and non-empty.
+--
+-- We can use this to find the longest entry of a list:
+--
+-- >>> maximumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"]
+-- "Longest"
 maximumBy               :: (a -> a -> Ordering) -> [a] -> a
 maximumBy _ []          =  errorWithoutStackTrace "List.maximumBy: empty list"
 maximumBy cmp xs        =  foldl1 maxBy xs
@@ -574,6 +654,11 @@ maximumBy cmp xs        =  foldl1 maxBy xs
 -- | The 'minimumBy' function takes a comparison function and a list
 -- and returns the least element of the list by the comparison function.
 -- The list must be finite and non-empty.
+--
+-- We can use this to find the shortest entry of a list:
+--
+-- >>> minimumBy (\x y -> compare (length x) (length y)) ["Hello", "World", "!", "Longest", "bar"]
+-- "!"
 minimumBy               :: (a -> a -> Ordering) -> [a] -> a
 minimumBy _ []          =  errorWithoutStackTrace "List.minimumBy: empty list"
 minimumBy cmp xs        =  foldl1 minBy xs
@@ -734,7 +819,8 @@ deleteFirstsBy eq       =  foldl (flip (deleteBy eq))
 -- that the concatenation of the result is equal to the argument.  Moreover,
 -- each sublist in the result contains only equal elements.  For example,
 --
--- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]
+-- >>> group "Mississippi"
+-- ["M","i","ss","i","ss","i","pp","i"]
 --
 -- It is a special case of 'groupBy', which allows the programmer to supply
 -- their own equality test.
@@ -750,7 +836,8 @@ groupBy eq (x:xs)       =  (x:ys) : groupBy eq zs
 -- | The 'inits' function returns all initial segments of the argument,
 -- shortest first.  For example,
 --
--- > inits "abc" == ["","a","ab","abc"]
+-- >>> inits "abc"
+-- ["","a","ab","abc"]
 --
 -- Note that 'inits' has the following strictness property:
 -- @inits (xs ++ _|_) = inits xs ++ _|_@
@@ -768,7 +855,8 @@ inits                   = map toListSB . scanl' snocSB emptySB
 -- | The 'tails' function returns all final segments of the argument,
 -- longest first.  For example,
 --
--- > tails "abc" == ["abc", "bc", "c",""]
+-- >>> tails "abc"
+-- ["abc","bc","c",""]
 --
 -- Note that 'tails' has the following strictness property:
 -- @tails _|_ = _|_ : _|_@
@@ -782,14 +870,16 @@ tails lst               =  build (\c n ->
 
 -- | The 'subsequences' function returns the list of all subsequences of the argument.
 --
--- > subsequences "abc" == ["","a","b","ab","c","ac","bc","abc"]
+-- >>> subsequences "abc"
+-- ["","a","b","ab","c","ac","bc","abc"]
 subsequences            :: [a] -> [[a]]
 subsequences xs         =  [] : nonEmptySubsequences xs
 
 -- | The 'nonEmptySubsequences' function returns the list of all subsequences of the argument,
 --   except for the empty list.
 --
--- > nonEmptySubsequences "abc" == ["a","b","ab","c","ac","bc","abc"]
+-- >>> nonEmptySubsequences "abc"
+-- ["a","b","ab","c","ac","bc","abc"]
 nonEmptySubsequences         :: [a] -> [[a]]
 nonEmptySubsequences []      =  []
 nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
@@ -798,7 +888,8 @@ nonEmptySubsequences (x:xs)  =  [x] : foldr f [] (nonEmptySubsequences xs)
 
 -- | The 'permutations' function returns the list of all permutations of the argument.
 --
--- > permutations "abc" == ["abc","bac","cba","bca","cab","acb"]
+-- >>> permutations "abc"
+-- ["abc","bac","cba","bca","cab","acb"]
 permutations            :: [a] -> [[a]]
 permutations xs0        =  xs0 : perms xs0 []
   where
@@ -819,9 +910,15 @@ permutations xs0        =  xs0 : perms xs0 []
 --
 -- Elements are arranged from from lowest to highest, keeping duplicates in
 -- the order they appeared in the input.
+--
+-- >>> sort [1,6,4,3,2,5]
+-- [1,2,3,4,5,6]
 sort :: (Ord a) => [a] -> [a]
 
 -- | The 'sortBy' function is the non-overloaded version of 'sort'.
+--
+-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")]
+-- [(1,"Hello"),(2,"world"),(4,"!")]
 sortBy :: (a -> a -> Ordering) -> [a] -> [a]
 
 #if defined(USE_REPORT_PRELUDE)
@@ -987,6 +1084,9 @@ rqpart cmp x (y:ys) rle rgt r =
 -- Elements are arranged from from lowest to highest, keeping duplicates in
 -- the order they appeared in the input.
 --
+-- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")]
+-- [(1,"Hello"),(2,"world"),(4,"!")]
+--
 -- @since 4.8.0.0
 sortOn :: Ord b => (a -> b) -> [a] -> [a]
 sortOn f =
@@ -1012,8 +1112,8 @@ sortOn f =
 --
 -- A simple use of unfoldr:
 --
--- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
--- >  [10,9,8,7,6,5,4,3,2,1]
+-- >>> unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10
+-- [10,9,8,7,6,5,4,3,2,1]
 --
 
 -- Note [INLINE unfoldr]
@@ -1058,13 +1158,26 @@ unfoldr f b0 = build (\c n ->
 -- last part of the string is considered a line even if it doesn't end
 -- with a newline. For example,
 --
--- > lines "" == []
--- > lines "\n" == [""]
--- > lines "one" == ["one"]
--- > lines "one\n" == ["one"]
--- > lines "one\n\n" == ["one",""]
--- > lines "one\ntwo" == ["one","two"]
--- > lines "one\ntwo\n" == ["one","two"]
+-- >>> lines ""
+-- []
+--
+-- >>> lines "\n"
+-- [""]
+--
+-- >>> lines "one"
+-- ["one"]
+--
+-- >>> lines "one\n"
+-- ["one"]
+--
+-- >>> lines "one\n\n"
+-- ["one",""]
+--
+-- >>> lines "one\ntwo"
+-- ["one","two"]
+--
+-- >>> lines "one\ntwo\n"
+-- ["one","two"]
 --
 -- Thus @'lines' s@ contains at least as many elements as newlines in @s@.
 lines                   :: String -> [String]
@@ -1082,6 +1195,9 @@ lines s                 =  cons (case break (== '\n') s of
 
 -- | 'unlines' is an inverse operation to 'lines'.
 -- It joins lines, after appending a terminating newline to each.
+--
+-- >>> unlines ["Hello", "World", "!"]
+-- "Hello\nWorld\n!\n"
 unlines                 :: [String] -> String
 #if defined(USE_REPORT_PRELUDE)
 unlines                 =  concatMap (++ "\n")
@@ -1094,6 +1210,9 @@ unlines (l:ls) = l ++ '\n' : unlines ls
 
 -- | 'words' breaks a string up into a list of words, which were delimited
 -- by white space.
+--
+-- >>> words "Lorem ipsum\ndolor"
+-- ["Lorem","ipsum","dolor"]
 words                   :: String -> [String]
 {-# NOINLINE [1] words #-}
 words s                 =  case dropWhile {-partain:Char.-}isSpace s of
@@ -1117,6 +1236,9 @@ wordsFB c n = go
 
 -- | 'unwords' is an inverse operation to 'words'.
 -- It joins words with separating spaces.
+--
+-- >>> unwords ["Lorem", "ipsum", "dolor"]
+-- "Lorem ipsum dolor"
 unwords                 :: [String] -> String
 #if defined(USE_REPORT_PRELUDE)
 unwords []              =  ""
diff --git a/libraries/base/Data/Typeable.hs b/libraries/base/Data/Typeable.hs
index 6157e82b1f..61b70cfd2e 100644
--- a/libraries/base/Data/Typeable.hs
+++ b/libraries/base/Data/Typeable.hs
@@ -86,8 +86,6 @@ module Data.Typeable
 
       -- * For backwards compatibility
     , typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7
-    , Typeable1, Typeable2, Typeable3, Typeable4
-    , Typeable5, Typeable6, Typeable7
     ) where
 
 import qualified Data.Typeable.Internal as I
@@ -225,19 +223,3 @@ typeOf6 _ = I.someTypeRep (Proxy :: Proxy t)
 typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)
                 (g :: *). Typeable t => t a b c d e f g -> TypeRep
 typeOf7 _ = I.someTypeRep (Proxy :: Proxy t)
-
-type Typeable1 (a :: * -> *)                               = Typeable a
-type Typeable2 (a :: * -> * -> *)                          = Typeable a
-type Typeable3 (a :: * -> * -> * -> *)                     = Typeable a
-type Typeable4 (a :: * -> * -> * -> * -> *)                = Typeable a
-type Typeable5 (a :: * -> * -> * -> * -> * -> *)           = Typeable a
-type Typeable6 (a :: * -> * -> * -> * -> * -> * -> *)      = Typeable a
-type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a
-
-{-# DEPRECATED Typeable1 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable2 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable3 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable4 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable5 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable6 "renamed to 'Typeable'" #-} -- deprecated in 7.8
-{-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8
diff --git a/libraries/base/GHC/Environment.hs b/libraries/base/GHC/Environment.hs
index a077f6f8c4..0270aedf55 100644
--- a/libraries/base/GHC/Environment.hs
+++ b/libraries/base/GHC/Environment.hs
@@ -8,11 +8,10 @@ import Foreign
 import Foreign.C
 import GHC.Base
 import GHC.Real ( fromIntegral )
+import GHC.IO.Encoding
+import qualified GHC.Foreign as GHC
 
 #if defined(mingw32_HOST_OS)
-import GHC.IO (finally)
-import GHC.Windows
-
 # if defined(i386_HOST_ARCH)
 #  define WINDOWS_CCONV stdcall
 # elif defined(x86_64_HOST_ARCH)
@@ -20,9 +19,6 @@ import GHC.Windows
 # else
 #  error Unknown mingw32 arch
 # endif
-#else
-import GHC.IO.Encoding
-import qualified GHC.Foreign as GHC
 #endif
 
 -- | Computation 'getFullArgs' is the "raw" version of 'getArgs', similar
@@ -30,37 +26,14 @@ import qualified GHC.Foreign as GHC
 -- command line arguments, starting with the program name, and
 -- including those normally eaten by the RTS (+RTS ... -RTS).
 getFullArgs :: IO [String]
-#if defined(mingw32_HOST_OS)
--- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
 getFullArgs = do
-    p_arg_string <- c_GetCommandLine
-    alloca $ \p_argc -> do
-     p_argv <- c_CommandLineToArgv p_arg_string p_argc
-     if p_argv == nullPtr
-      then throwGetLastError "getFullArgs"
-      else flip finally (c_LocalFree p_argv) $ do
-       argc <- peek p_argc
-       p_argvs <- peekArray (fromIntegral argc) p_argv
-       mapM peekCWString p_argvs
-
-foreign import WINDOWS_CCONV unsafe "windows.h GetCommandLineW"
-    c_GetCommandLine :: IO (Ptr CWString)
-
-foreign import WINDOWS_CCONV unsafe "windows.h CommandLineToArgvW"
-    c_CommandLineToArgv :: Ptr CWString -> Ptr CInt -> IO (Ptr CWString)
-
-foreign import WINDOWS_CCONV unsafe "Windows.h LocalFree"
-    c_LocalFree :: Ptr a -> IO (Ptr a)
-#else
-getFullArgs =
-  alloca $ \ p_argc ->
-  alloca $ \ p_argv -> do
-   getFullProgArgv p_argc p_argv
-   p    <- fromIntegral `liftM` peek p_argc
-   argv <- peek p_argv
-   enc <- getFileSystemEncoding
-   peekArray p argv >>= mapM (GHC.peekCString enc)
+  alloca $ \ p_argc -> do
+    alloca $ \ p_argv -> do
+        getFullProgArgv p_argc p_argv
+        p    <- fromIntegral `liftM` peek p_argc
+        argv <- peek p_argv
+        enc <- argvEncoding
+        peekArray p argv >>= mapM (GHC.peekCString enc)
 
 foreign import ccall unsafe "getFullProgArgv"
     getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
-#endif
diff --git a/libraries/base/GHC/IO/Encoding.hs b/libraries/base/GHC/IO/Encoding.hs
index 578a420faf..daff97e560 100644
--- a/libraries/base/GHC/IO/Encoding.hs
+++ b/libraries/base/GHC/IO/Encoding.hs
@@ -27,6 +27,7 @@ module GHC.IO.Encoding (
         setLocaleEncoding, setFileSystemEncoding, setForeignEncoding,
         char8,
         mkTextEncoding,
+        argvEncoding
     ) where
 
 import GHC.Base
@@ -161,6 +162,17 @@ initFileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure
 initForeignEncoding    = CodePage.mkLocaleEncoding IgnoreCodingFailure
 #endif
 
+-- See Note [Windows Unicode Arguments] in rts/RtsFlags.c
+-- On Windows we assume hs_init argv is in utf8 encoding.
+
+-- | Internal encoding of argv
+argvEncoding :: IO TextEncoding
+#if defined(mingw32_HOST_OS)
+argvEncoding = return utf8
+#else
+argvEncoding = getFileSystemEncoding
+#endif
+
 -- | An encoding in which Unicode code points are translated to bytes
 -- by taking the code point modulo 256.  When decoding, bytes are
 -- translated directly into the equivalent code point.
diff --git a/libraries/base/GHC/Natural.hs b/libraries/base/GHC/Natural.hs
index 0e5abc77bc..13560850af 100644
--- a/libraries/base/GHC/Natural.hs
+++ b/libraries/base/GHC/Natural.hs
@@ -47,16 +47,10 @@ module GHC.Natural
 
 #include "MachDeps.h"
 
-#if defined(MIN_VERSION_integer_gmp)
-# define HAVE_GMP_BIGNAT MIN_VERSION_integer_gmp(1,0,0)
-#else
-# define HAVE_GMP_BIGNAT 0
-#endif
-
 import GHC.Arr
 import GHC.Base
 import {-# SOURCE #-} GHC.Exception (underflowException)
-#if HAVE_GMP_BIGNAT
+#if defined(MIN_VERSION_integer_gmp)
 import GHC.Integer.GMP.Internals
 import Data.Word
 import Data.Int
@@ -87,7 +81,7 @@ underflowError = raise# underflowException
 -- Natural type
 -------------------------------------------------------------------------------
 
-#if HAVE_GMP_BIGNAT
+#if defined(MIN_VERSION_integer_gmp)
 -- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0'
 
 -- | Type representing arbitrary-precision non-negative integers.
@@ -450,7 +444,7 @@ naturalToInt :: Natural -> Int
 naturalToInt (NatS# w#) = I# (word2Int# w#)
 naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
 
-#else /* !HAVE_GMP_BIGNAT */
+#else /* !defined(MIN_VERSION_integer_gmp) */
 ----------------------------------------------------------------------------
 -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package
 
@@ -606,7 +600,7 @@ instance Integral Natural where
 --
 -- @since 4.8.0.0
 wordToNatural :: Word -> Natural
-#if HAVE_GMP_BIGNAT
+#if defined(MIN_VERSION_integer_gmp)
 wordToNatural (W# w#) = NatS# w#
 #else
 wordToNatural w = Natural (fromIntegral w)
@@ -617,7 +611,7 @@ wordToNatural w = Natural (fromIntegral w)
 --
 -- @since 4.8.0.0
 naturalToWordMaybe :: Natural -> Maybe Word
-#if HAVE_GMP_BIGNAT
+#if defined(MIN_VERSION_integer_gmp)
 naturalToWordMaybe (NatS# w#) = Just (W# w#)
 naturalToWordMaybe (NatJ# _)  = Nothing
 #else
@@ -633,7 +627,7 @@ naturalToWordMaybe (Natural i)
 --
 -- @since 4.8.0.0
 powModNatural :: Natural -> Natural -> Natural -> Natural
-#if HAVE_GMP_BIGNAT
+#if defined(MIN_VERSION_integer_gmp)
 powModNatural _           _           (NatS# 0##) = divZeroError
 powModNatural _           _           (NatS# 1##) = NatS# 0##
 powModNatural _           (NatS# 0##) _           = NatS# 1##
diff --git a/libraries/base/GHC/Real.hs b/libraries/base/GHC/Real.hs
index 1154091dd5..6206598e39 100644
--- a/libraries/base/GHC/Real.hs
+++ b/libraries/base/GHC/Real.hs
@@ -646,7 +646,6 @@ lcm x y         =  abs ((x `quot` (gcd x y)) * y)
 gcdInt' :: Int -> Int -> Int
 gcdInt' (I# x) (I# y) = I# (gcdInt x y)
 
-#if MIN_VERSION_integer_gmp(1,0,0)
 {-# RULES
 "gcd/Word->Word->Word"          gcd = gcdWord'
  #-}
@@ -654,7 +653,6 @@ gcdInt' (I# x) (I# y) = I# (gcdInt x y)
 gcdWord' :: Word -> Word -> Word
 gcdWord' (W# x) (W# y) = W# (gcdWord x y)
 #endif
-#endif
 
 integralEnumFrom :: (Integral a, Bounded a) => a -> [a]
 integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)]
diff --git a/libraries/base/GHC/Stack.hs b/libraries/base/GHC/Stack.hs
index f5b175c0bb..1f102c9f9b 100644
--- a/libraries/base/GHC/Stack.hs
+++ b/libraries/base/GHC/Stack.hs
@@ -85,7 +85,10 @@ popCallStack stk = case stk of
 --
 -- @since 4.9.0.0
 callStack :: HasCallStack => CallStack
-callStack = popCallStack ?callStack
+callStack =
+  case ?callStack of
+    EmptyCallStack -> EmptyCallStack
+    _              -> popCallStack ?callStack
 {-# INLINE callStack #-}
 
 -- | Perform some computation without adding new entries to the 'CallStack'.
diff --git a/libraries/base/System/Environment.hs b/libraries/base/System/Environment.hs
index 56e6961f8a..343b7722c6 100644
--- a/libraries/base/System/Environment.hs
+++ b/libraries/base/System/Environment.hs
@@ -38,13 +38,13 @@ import Control.Exception.Base (bracket)
 #endif
 -- import GHC.IO
 import GHC.IO.Exception
-import GHC.IO.Encoding (getFileSystemEncoding)
 import qualified GHC.Foreign as GHC
 import Control.Monad
 #if defined(mingw32_HOST_OS)
-import GHC.Environment
+import GHC.IO.Encoding (argvEncoding)
 import GHC.Windows
 #else
+import GHC.IO.Encoding (getFileSystemEncoding, argvEncoding)
 import System.Posix.Internals (withFilePath)
 #endif
 
@@ -65,89 +65,21 @@ import System.Environment.ExecutablePath
 -- ---------------------------------------------------------------------------
 -- getArgs, getProgName, getEnv
 
-#if defined(mingw32_HOST_OS)
-
-{-
-Note [Ignore hs_init argv]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-Ignore the arguments to hs_init on Windows for the sake of Unicode compat
-
-Instead on Windows we get the list of arguments from getCommandLineW and
-filter out arguments which the RTS would not have passed along.
-
-This is done to ensure we get the arguments in proper Unicode Encoding which
-the RTS at this moment does not seem provide. The filtering has to match the
-one done by the RTS to avoid inconsistencies like #13287.
--}
-
-getWin32ProgArgv_certainly :: IO [String]
-getWin32ProgArgv_certainly = do
-        mb_argv <- getWin32ProgArgv
-        case mb_argv of
-          -- see Note [Ignore hs_init argv]
-          Nothing   -> fmap dropRTSArgs getFullArgs
-          Just argv -> return argv
-
-withWin32ProgArgv :: [String] -> IO a -> IO a
-withWin32ProgArgv argv act = bracket begin setWin32ProgArgv (\_ -> act)
-  where
-    begin = do
-          mb_old_argv <- getWin32ProgArgv
-          setWin32ProgArgv (Just argv)
-          return mb_old_argv
-
-getWin32ProgArgv :: IO (Maybe [String])
-getWin32ProgArgv = alloca $ \p_argc -> alloca $ \p_argv -> do
-        c_getWin32ProgArgv p_argc p_argv
-        argc <- peek p_argc
-        argv_p <- peek p_argv
-        if argv_p == nullPtr
-         then return Nothing
-         else do
-          argv_ps <- peekArray (fromIntegral argc) argv_p
-          fmap Just $ mapM peekCWString argv_ps
-
-setWin32ProgArgv :: Maybe [String] -> IO ()
-setWin32ProgArgv Nothing = c_setWin32ProgArgv 0 nullPtr
-setWin32ProgArgv (Just argv) = withMany withCWString argv $ \argv_ps -> withArrayLen argv_ps $ \argc argv_p -> do
-        c_setWin32ProgArgv (fromIntegral argc) argv_p
-
-foreign import ccall unsafe "getWin32ProgArgv"
-  c_getWin32ProgArgv :: Ptr CInt -> Ptr (Ptr CWString) -> IO ()
-
-foreign import ccall unsafe "setWin32ProgArgv"
-  c_setWin32ProgArgv :: CInt -> Ptr CWString -> IO ()
-
--- See Note [Ignore hs_init argv]
-dropRTSArgs :: [String] -> [String]
-dropRTSArgs []             = []
-dropRTSArgs rest@("--":_)  = rest
-dropRTSArgs ("+RTS":rest)  = dropRTSArgs (dropWhile (/= "-RTS") rest)
-dropRTSArgs ("--RTS":rest) = rest
-dropRTSArgs ("-RTS":rest)  = dropRTSArgs rest
-dropRTSArgs (arg:rest)     = arg : dropRTSArgs rest
-
-#endif
-
 -- | Computation 'getArgs' returns a list of the program's command
 -- line arguments (not including the program name).
 getArgs :: IO [String]
-
-#if defined(mingw32_HOST_OS)
-getArgs =  fmap tail getWin32ProgArgv_certainly
-#else
 getArgs =
   alloca $ \ p_argc ->
   alloca $ \ p_argv -> do
    getProgArgv p_argc p_argv
    p    <- fromIntegral `liftM` peek p_argc
    argv <- peek p_argv
-   enc <- getFileSystemEncoding
+   enc <- argvEncoding
    peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
 
+
 foreign import ccall unsafe "getProgArgv"
   getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
-#endif
 
 {-|
 Computation 'getProgName' returns the name of the program as it was
@@ -160,10 +92,7 @@ between platforms: on Windows, for example, a program invoked as foo
 is probably really @FOO.EXE@, and that is what 'getProgName' will return.
 -}
 getProgName :: IO String
-#if defined(mingw32_HOST_OS)
 -- Ignore the arguments to hs_init on Windows for the sake of Unicode compat
-getProgName = fmap (basename . head) getWin32ProgArgv_certainly
-#else
 getProgName =
   alloca $ \ p_argc ->
   alloca $ \ p_argv -> do
@@ -173,10 +102,9 @@ getProgName =
 
 unpackProgName  :: Ptr (Ptr CChar) -> IO String   -- argv[0]
 unpackProgName argv = do
-  enc <- getFileSystemEncoding
+  enc <- argvEncoding
   s <- peekElemOff argv 0 >>= GHC.peekCString enc
   return (basename s)
-#endif
 
 basename :: FilePath -> FilePath
 basename f = go f f
@@ -262,9 +190,10 @@ ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
 
 -- | @setEnv name value@ sets the specified environment variable to @value@.
 --
--- On Windows setting an environment variable to the /empty string/ removes
+-- Early versions of this function operated under the mistaken belief that
+-- setting an environment variable to the /empty string/ on Windows removes
 -- that environment variable from the environment.  For the sake of
--- compatibility we adopt that behavior.  In particular
+-- compatibility, it adopted that behavior on POSIX.  In particular
 --
 -- @
 -- setEnv name \"\"
@@ -276,9 +205,8 @@ ioe_missingEnvVar name = ioException (IOError Nothing NoSuchThing "getEnv"
 -- `unsetEnv` name
 -- @
 --
--- If you don't care about Windows support and want to set an environment
--- variable to the empty string use @System.Posix.Env.setEnv@ from the @unix@
--- package instead.
+-- If you'd like to be able to set environment variables to blank strings,
+-- use `System.Environment.Blank.setEnv`.
 --
 -- Throws `Control.Exception.IOException` if @name@ is the empty string or
 -- contains an equals sign.
@@ -371,15 +299,7 @@ withProgName nm act = do
 -- the duration of an action.
 
 withArgv :: [String] -> IO a -> IO a
-
-#if defined(mingw32_HOST_OS)
--- We have to reflect the updated arguments in the RTS-side variables as
--- well, because the RTS still consults them for error messages and the like.
--- If we don't do this then ghc-e005 fails.
-withArgv new_args act = withWin32ProgArgv new_args $ withProgArgv new_args act
-#else
 withArgv = withProgArgv
-#endif
 
 withProgArgv :: [String] -> IO a -> IO a
 withProgArgv new_args act = do
@@ -391,7 +311,7 @@ withProgArgv new_args act = do
 
 setProgArgv :: [String] -> IO ()
 setProgArgv argv = do
-  enc <- getFileSystemEncoding
+  enc <- argvEncoding
   GHC.withCStringsLen enc argv $ \len css ->
     c_setProgArgv (fromIntegral len) css
 
diff --git a/libraries/base/System/Environment/Blank.hsc b/libraries/base/System/Environment/Blank.hsc
new file mode 100644
index 0000000000..ebca1ef150
--- /dev/null
+++ b/libraries/base/System/Environment/Blank.hsc
@@ -0,0 +1,196 @@
+{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE CApiFFI #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  System.Environment.Blank
+-- Copyright   :  (c) Habib Alamin 2017
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+--
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- A setEnv implementation that allows blank environment variables. Mimics
+-- the `System.Posix.Env` module from the @unix@ package, but with support
+-- for Windows too.
+--
+-- The matrix of platforms that:
+--
+--   * support putenv("FOO") to unset environment variables,
+--   * support putenv("FOO=") to unset environment variables or set them
+--     to blank values,
+--   * support unsetenv to unset environment variables,
+--   * support setenv to set environment variables,
+--   * etc.
+--
+-- is very complicated. I think AIX is screwed, but we don't support it.
+-- The whole situation with setenv(3), unsetenv(3), and putenv(3) is not
+-- good. Even mingw32 adds its own crap to the pile, but luckily, we can
+-- just use Windows' native environment functions to sidestep the issue.
+--
+-- #12494
+--
+-----------------------------------------------------------------------------
+
+module System.Environment.Blank
+    (
+      module System.Environment,
+      getEnv,
+      getEnvDefault,
+      setEnv,
+      unsetEnv,
+  ) where
+
+import Foreign.C
+#ifdef mingw32_HOST_OS
+import Foreign.Ptr
+import GHC.Windows
+import Control.Monad
+#else
+import System.Posix.Internals
+#endif
+import GHC.IO.Exception
+import System.IO.Error
+import Control.Exception.Base
+import Data.Maybe
+
+import System.Environment
+    (
+      getArgs,
+      getProgName,
+      getExecutablePath,
+      withArgs,
+      withProgName,
+      getEnvironment
+  )
+#ifndef mingw32_HOST_OS
+import qualified System.Environment as Environment
+#endif
+
+-- TODO: include windows_cconv.h when it's merged, instead of duplicating
+-- this C macro block.
+#if defined(mingw32_HOST_OS)
+# if defined(i386_HOST_ARCH)
+##  define WINDOWS_CCONV stdcall
+# elif defined(x86_64_HOST_ARCH)
+##  define WINDOWS_CCONV ccall
+# else
+##  error Unknown mingw32 arch
+# endif
+#endif
+
+#include "HsBaseConfig.h"
+
+throwInvalidArgument :: String -> IO a
+throwInvalidArgument from =
+  throwIO (mkIOError InvalidArgument from Nothing Nothing)
+
+-- | `System.Environment.lookupEnv`.
+getEnv :: String -> IO (Maybe String)
+#ifdef mingw32_HOST_OS
+getEnv = (<$> getEnvironment) . lookup
+#else
+getEnv = Environment.lookupEnv
+#endif
+
+-- | Get an environment value or a default value.
+getEnvDefault ::
+  String    {- ^ variable name                    -} ->
+  String    {- ^ fallback value                   -} ->
+  IO String {- ^ variable value or fallback value -}
+getEnvDefault name fallback = fromMaybe fallback <$> getEnv name
+
+-- | Like `System.Environment.setEnv`, but allows blank environment values
+-- and mimics the function signature of `System.Posix.Env.setEnv` from the
+-- @unix@ package.
+setEnv ::
+  String {- ^ variable name  -} ->
+  String {- ^ variable value -} ->
+  Bool   {- ^ overwrite      -} ->
+  IO ()
+setEnv key_ value_ overwrite
+  | null key       = throwInvalidArgument "setEnv"
+  | '=' `elem` key = throwInvalidArgument "setEnv"
+  | otherwise      =
+    if overwrite
+    then setEnv_ key value
+    else do
+      env_var <- getEnv key
+      case env_var of
+          Just _  -> return ()
+          Nothing -> setEnv_ key value
+  where
+    key   = takeWhile (/= '\NUL') key_
+    value = takeWhile (/= '\NUL') value_
+
+setEnv_ :: String -> String -> IO ()
+#if defined(mingw32_HOST_OS)
+setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do
+  success <- c_SetEnvironmentVariable k v
+  unless success (throwGetLastError "setEnv")
+
+foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"
+  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> IO Bool
+#else
+setEnv_ key value =
+  withFilePath key $ \ keyP ->
+    withFilePath value $ \ valueP ->
+      throwErrnoIfMinus1_ "setenv" $
+        c_setenv keyP valueP (fromIntegral (fromEnum True))
+
+foreign import ccall unsafe "setenv"
+   c_setenv :: CString -> CString -> CInt -> IO CInt
+#endif
+
+-- | Like `System.Environment.unsetEnv`, but allows for the removal of
+-- blank environment variables.
+unsetEnv :: String -> IO ()
+#if defined(mingw32_HOST_OS)
+unsetEnv key = withCWString key $ \k -> do
+  success <- c_SetEnvironmentVariable k nullPtr
+  unless success $ do
+    -- We consider unsetting an environment variable that does not exist not as
+    -- an error, hence we ignore eRROR_ENVVAR_NOT_FOUND.
+    err <- c_GetLastError
+    unless (err == eRROR_ENVVAR_NOT_FOUND) $ do
+      throwGetLastError "unsetEnv"
+
+eRROR_ENVVAR_NOT_FOUND :: DWORD
+eRROR_ENVVAR_NOT_FOUND = 203
+
+foreign import WINDOWS_CCONV unsafe "windows.h GetLastError"
+  c_GetLastError:: IO DWORD
+#elif HAVE_UNSETENV
+# if !UNSETENV_RETURNS_VOID
+unsetEnv name = withFilePath name $ \ s ->
+  throwErrnoIfMinus1_ "unsetenv" (c_unsetenv s)
+
+-- POSIX.1-2001 compliant unsetenv(3)
+foreign import capi unsafe "HsBase.h unsetenv"
+   c_unsetenv :: CString -> IO CInt
+# else
+unsetEnv name = withFilePath name c_unsetenv
+
+-- pre-POSIX unsetenv(3) returning @void@
+foreign import capi unsafe "HsBase.h unsetenv"
+   c_unsetenv :: CString -> IO ()
+# endif
+#else
+unsetEnv name =
+  if '=' `elem` name
+  then throwInvalidArgument "unsetEnv"
+  else putEnv name
+
+putEnv :: String -> IO ()
+putEnv keyvalue = do
+  s <- getFileSystemEncoding >>= (`newCString` keyvalue)
+  -- IMPORTANT: Do not free `s` after calling putenv!
+  --
+  -- According to SUSv2, the string passed to putenv becomes part of the
+  -- environment. #7342
+  throwErrnoIf_ (/= 0) "putenv" (c_putenv s)
+
+foreign import ccall unsafe "putenv" c_putenv :: CString -> IO CInt
+#endif
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index 9429de05c3..4bbe2f2d51 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -289,6 +289,7 @@ Library
         System.CPUTime
         System.Console.GetOpt
         System.Environment
+        System.Environment.Blank
         System.Exit
         System.IO
         System.IO.Error
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 0cfd9c1ba8..708676fe65 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -10,6 +10,10 @@
 
   * Add `infixl 9 !!` declaration for `Data.List.NonEmpty.!!`
 
+  * Add `<&>` operator to `Data.Functor` (#14029)
+
+  * Remove the deprecated `Typeable{1..7}` type synonyms (#14047)
+
 ## 4.10.0.0 *April 2017*
   * Bundled with GHC *TBA*
 
diff --git a/libraries/base/tests/T12494.hs b/libraries/base/tests/T12494.hs
new file mode 100644
index 0000000000..544f5ed908
--- /dev/null
+++ b/libraries/base/tests/T12494.hs
@@ -0,0 +1,36 @@
+import System.Environment.Blank
+
+main = do
+  let envVar = "AN_ENVIRONMENT_VARIABLE"
+
+  valueBeforeSettingVariable <- getEnv envVar
+  print valueBeforeSettingVariable -- Nothing
+
+  valueWithDefaultBeforeSetting <- getEnvDefault envVar "DEFAULT"
+  print valueWithDefaultBeforeSetting -- "DEFAULT"
+
+  setEnv envVar "" False
+
+  valueAfterSettingVariable <- getEnv envVar
+  print valueAfterSettingVariable -- Just ""
+
+  valueWithDefaultAfterSetting <- getEnvDefault envVar "DEFAULT"
+  print valueWithDefaultAfterSetting -- ""
+
+  valueFromGetEnvironment <- lookup envVar <$> getEnvironment
+  print valueFromGetEnvironment -- Just ""
+
+  setEnv envVar "NO_OVERRIDE" False
+
+  valueAfterSettingWithExistingValueAndOverrideFalse <- getEnv envVar
+  print valueAfterSettingWithExistingValueAndOverrideFalse -- Just ""
+
+  setEnv envVar "OVERRIDE" True
+
+  valueAfterSettingWithExistingValueAndOverrideTrue <- getEnv envVar
+  print valueAfterSettingWithExistingValueAndOverrideTrue -- Just "OVERRIDE"
+
+  unsetEnv envVar
+
+  valueAfterUnsettingVariable <- getEnv envVar
+  print valueAfterUnsettingVariable -- Nothing
diff --git a/libraries/base/tests/T12494.stdout b/libraries/base/tests/T12494.stdout
new file mode 100644
index 0000000000..a3b77cc271
--- /dev/null
+++ b/libraries/base/tests/T12494.stdout
@@ -0,0 +1,8 @@
+Nothing
+"DEFAULT"
+Just ""
+""
+Just ""
+Just ""
+Just "OVERRIDE"
+Nothing
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index 4bd8084220..d97d79afe3 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -201,6 +201,7 @@ test('T9848',
 test('T10149', normal, compile_and_run, [''])
 test('T11334a', normal, compile_and_run, [''])
 test('T11555', normal, compile_and_run, [''])
+test('T12494', normal, compile_and_run, [''])
 test('T12852', when(opsys('mingw32'), skip), compile_and_run, [''])
 test('lazySTexamples', normal, compile_and_run, [''])
 test('T11760', normal, compile_and_run, ['-threaded -with-rtsopts=-N2'])
@@ -214,3 +215,4 @@ test('T13191',
       ['-O'])
 test('T13525', when(opsys('mingw32'), skip), compile_and_run, [''])
 test('T13097', normal, compile_and_run, [''])
+test('functorOperators', normal, compile_and_run, [''])
diff --git a/libraries/base/tests/functorOperators.hs b/libraries/base/tests/functorOperators.hs
new file mode 100644
index 0000000000..aea5dfda80
--- /dev/null
+++ b/libraries/base/tests/functorOperators.hs
@@ -0,0 +1,38 @@
+-- Test infix operators of 'Functor'
+
+import Data.Functor
+
+main :: IO ()
+main = do
+        testInfixFmap
+        testFlippedInfixFmap
+        testInfixReplace
+        testFlippedInfixReplace
+
+testInfixFmap :: IO ()
+testInfixFmap = do
+        print "<$> tests:"
+        print $ (+ 1) <$> Just 2 -- => Just 3
+        print (((+ 1) <$> Right 3) :: Either Int Int) -- => Right 4
+        print $ (+ 1) <$> [1, 2, 3] -- => [2,3,4]
+
+testFlippedInfixFmap :: IO ()
+testFlippedInfixFmap = do
+        print "<&> tests:"
+        print $ Just 2 <&> (+ 1) -- => Just 3
+        print ((Right 3 <&> (+ 1)) :: Either Int Int) -- => Right 4
+        print $ [1, 2, 3] <&> (+ 1) -- => [2,3,4]
+
+testInfixReplace :: IO ()
+testInfixReplace = do
+        print "<$ tests:"
+        print $ 42 <$ Just 1 -- => Just 42
+        print ((42 <$ Right 1) :: Either Int Int) -- => Right 42
+        print $ 42 <$ [1, 2, 3] -- => [42,42,42]
+
+testFlippedInfixReplace :: IO ()
+testFlippedInfixReplace = do
+        print "$> tests:"
+        print $ Just 1 $> 42 -- => Just 42
+        print ((Right 1 $> 42) :: Either Int Int) -- => Right 42
+        print $ [1, 2, 3] $> 42 -- => [42,42,42]
diff --git a/libraries/base/tests/functorOperators.stdout b/libraries/base/tests/functorOperators.stdout
new file mode 100644
index 0000000000..00a17ed3b8
--- /dev/null
+++ b/libraries/base/tests/functorOperators.stdout
@@ -0,0 +1,16 @@
+"<$> tests:"
+Just 3
+Right 4
+[2,3,4]
+"<&> tests:"
+Just 3
+Right 4
+[2,3,4]
+"<$ tests:"
+Just 42
+Right 42
+[42,42,42]
+"$> tests:"
+Just 42
+Right 42
+[42,42,42]
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 81de2fbd21..fe63d641a4 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -48,11 +48,7 @@ import Data.Typeable (TypeRep)
 import Data.IORef
 import Data.Map (Map)
 import GHC.Generics
-#if MIN_VERSION_base(4,9,0)
 import GHC.Stack.CCS
-#else
-import GHC.Stack as GHC.Stack.CCS
-#endif
 import qualified Language.Haskell.TH        as TH
 import qualified Language.Haskell.TH.Syntax as TH
 import System.Exit
@@ -384,17 +380,7 @@ fromSerializableException EUserInterrupt = toException UserInterrupt
 fromSerializableException (EExitCode c) = toException c
 fromSerializableException (EOtherException str) = toException (ErrorCall str)
 
--- NB: Replace this with a derived instance once we depend on GHC 8.0
--- as the minimum
-instance Binary ExitCode where
-  put ExitSuccess      = putWord8 0
-  put (ExitFailure ec) = putWord8 1 >> put ec
-  get = do
-    w <- getWord8
-    case w of
-      0 -> pure ExitSuccess
-      _ -> ExitFailure <$> get
-
+instance Binary ExitCode
 instance Binary SerializableException
 
 data THResult a
diff --git a/libraries/ghci/GHCi/TH.hs b/libraries/ghci/GHCi/TH.hs
index 1b08501580..09fbca7e32 100644
--- a/libraries/ghci/GHCi/TH.hs
+++ b/libraries/ghci/GHCi/TH.hs
@@ -97,6 +97,7 @@ import GHC.Serialized
 
 import Control.Exception
 import qualified Control.Monad.Fail as Fail
+import Control.Monad.IO.Class (MonadIO (..))
 import Data.Binary
 import Data.Binary.Put
 import Data.ByteString (ByteString)
@@ -160,6 +161,9 @@ ghcCmd m = GHCiQ $ \s -> do
     THException str -> throwIO (GHCiQException s str)
     THComplete res -> return (res, s)
 
+instance MonadIO GHCiQ where
+  liftIO m = GHCiQ $ \s -> fmap (,s) m
+
 instance TH.Quasi GHCiQ where
   qNewName str = ghcCmd (NewName str)
   qReport isError msg = ghcCmd (Report isError msg)
@@ -190,7 +194,6 @@ instance TH.Quasi GHCiQ where
   qReifyModule m = ghcCmd (ReifyModule m)
   qReifyConStrictness name = ghcCmd (ReifyConStrictness name)
   qLocation = fromMaybe noLoc . qsLocation <$> getState
-  qRunIO m = GHCiQ $ \s -> fmap (,s) m
   qAddDependentFile file = ghcCmd (AddDependentFile file)
   qAddTopDecls decls = ghcCmd (AddTopDecls decls)
   qAddForeignFile str lang = ghcCmd (AddForeignFile str lang)
diff --git a/libraries/mtl b/libraries/mtl
new file mode 160000
+Subproject b4725fe28cba8a535e969e0ddbce3d5e05146cc
diff --git a/libraries/parsec b/libraries/parsec
new file mode 160000
+Subproject d21d86387998614de31697a26fd8fec15d40e62
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 78fbc41d6f..9ad36f8586 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -1,8 +1,13 @@
 -- |
--- TH.Lib contains lots of useful helper functions for
+-- Language.Haskell.TH.Lib contains lots of useful helper functions for
 -- generating and manipulating Template Haskell terms
 
-{-# LANGUAGE CPP #-}
+-- Note: this module mostly re-exports functions from
+-- Language.Haskell.TH.Lib.Internal, but if a change occurs to Template
+-- Haskell which requires breaking the API offered in this module, we opt to
+-- copy the old definition here, and make the changes in
+-- Language.Haskell.TH.Lib.Internal. This way, we can retain backwards
+-- compatibility while still allowing GHC to make changes as it needs.
 
 module Language.Haskell.TH.Lib (
     -- All of the exports from this module should
@@ -11,11 +16,12 @@ module Language.Haskell.TH.Lib (
 
     -- * Library functions
     -- ** Abbreviations
-        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ,
-        DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ,
-        SourceStrictnessQ, SourceUnpackednessQ, BangQ, BangTypeQ, VarBangTypeQ,
-        StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ,
-        TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+        InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, KindQ, TyVarBndrQ,
+        TyLitQ, CxtQ, PredQ, DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ,
+        StmtQ, RangeQ, SourceStrictnessQ, SourceUnpackednessQ, BangQ,
+        BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ,
+        FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ,
+        FamilyResultSigQ,
 
     -- ** Constructors lifted to 'Q'
     -- *** Literals
@@ -111,358 +117,45 @@ module Language.Haskell.TH.Lib (
 
    ) where
 
-import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
-import qualified Language.Haskell.TH.Syntax as TH
-import Control.Monad( liftM, liftM2 )
-import Data.Word( Word8 )
-
-----------------------------------------------------------
--- * Type synonyms
-----------------------------------------------------------
-
-type InfoQ               = Q Info
-type PatQ                = Q Pat
-type FieldPatQ           = Q FieldPat
-type ExpQ                = Q Exp
-type TExpQ a             = Q (TExp a)
-type DecQ                = Q Dec
-type DecsQ               = Q [Dec]
-type ConQ                = Q Con
-type TypeQ               = Q Type
-type TyLitQ              = Q TyLit
-type CxtQ                = Q Cxt
-type PredQ               = Q Pred
-type DerivClauseQ        = Q DerivClause
-type MatchQ              = Q Match
-type ClauseQ             = Q Clause
-type BodyQ               = Q Body
-type GuardQ              = Q Guard
-type StmtQ               = Q Stmt
-type RangeQ              = Q Range
-type SourceStrictnessQ   = Q SourceStrictness
-type SourceUnpackednessQ = Q SourceUnpackedness
-type BangQ               = Q Bang
-type BangTypeQ           = Q BangType
-type VarBangTypeQ        = Q VarBangType
-type StrictTypeQ         = Q StrictType
-type VarStrictTypeQ      = Q VarStrictType
-type FieldExpQ           = Q FieldExp
-type RuleBndrQ           = Q RuleBndr
-type TySynEqnQ           = Q TySynEqn
-type PatSynDirQ          = Q PatSynDir
-type PatSynArgsQ         = Q PatSynArgs
-
--- must be defined here for DsMeta to find it
-type Role                = TH.Role
-type InjectivityAnn      = TH.InjectivityAnn
-
-----------------------------------------------------------
--- * Lowercase pattern syntax functions
-----------------------------------------------------------
-
-intPrimL    :: Integer -> Lit
-intPrimL    = IntPrimL
-wordPrimL    :: Integer -> Lit
-wordPrimL    = WordPrimL
-floatPrimL  :: Rational -> Lit
-floatPrimL  = FloatPrimL
-doublePrimL :: Rational -> Lit
-doublePrimL = DoublePrimL
-integerL    :: Integer -> Lit
-integerL    = IntegerL
-charL       :: Char -> Lit
-charL       = CharL
-charPrimL   :: Char -> Lit
-charPrimL   = CharPrimL
-stringL     :: String -> Lit
-stringL     = StringL
-stringPrimL :: [Word8] -> Lit
-stringPrimL = StringPrimL
-rationalL   :: Rational -> Lit
-rationalL   = RationalL
-
-litP :: Lit -> PatQ
-litP l = return (LitP l)
-
-varP :: Name -> PatQ
-varP v = return (VarP v)
-
-tupP :: [PatQ] -> PatQ
-tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
-
-unboxedTupP :: [PatQ] -> PatQ
-unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
-
-unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
-unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
-
-conP :: Name -> [PatQ] -> PatQ
-conP n ps = do ps' <- sequence ps
-               return (ConP n ps')
-infixP :: PatQ -> Name -> PatQ -> PatQ
-infixP p1 n p2 = do p1' <- p1
-                    p2' <- p2
-                    return (InfixP p1' n p2')
-uInfixP :: PatQ -> Name -> PatQ -> PatQ
-uInfixP p1 n p2 = do p1' <- p1
-                     p2' <- p2
-                     return (UInfixP p1' n p2')
-parensP :: PatQ -> PatQ
-parensP p = do p' <- p
-               return (ParensP p')
-
-tildeP :: PatQ -> PatQ
-tildeP p = do p' <- p
-              return (TildeP p')
-bangP :: PatQ -> PatQ
-bangP p = do p' <- p
-             return (BangP p')
-asP :: Name -> PatQ -> PatQ
-asP n p = do p' <- p
-             return (AsP n p')
-wildP :: PatQ
-wildP = return WildP
-recP :: Name -> [FieldPatQ] -> PatQ
-recP n fps = do fps' <- sequence fps
-                return (RecP n fps')
-listP :: [PatQ] -> PatQ
-listP ps = do ps' <- sequence ps
-              return (ListP ps')
-sigP :: PatQ -> TypeQ -> PatQ
-sigP p t = do p' <- p
-              t' <- t
-              return (SigP p' t')
-viewP :: ExpQ -> PatQ -> PatQ
-viewP e p = do e' <- e
-               p' <- p
-               return (ViewP e' p')
-
-fieldPat :: Name -> PatQ -> FieldPatQ
-fieldPat n p = do p' <- p
-                  return (n, p')
-
-
--------------------------------------------------------------------------------
--- *   Stmt
-
-bindS :: PatQ -> ExpQ -> StmtQ
-bindS p e = liftM2 BindS p e
-
-letS :: [DecQ] -> StmtQ
-letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
-
-noBindS :: ExpQ -> StmtQ
-noBindS e = do { e1 <- e; return (NoBindS e1) }
-
-parS :: [[StmtQ]] -> StmtQ
-parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
-
--------------------------------------------------------------------------------
--- *   Range
-
-fromR :: ExpQ -> RangeQ
-fromR x = do { a <- x; return (FromR a) }
-
-fromThenR :: ExpQ -> ExpQ -> RangeQ
-fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
-
-fromToR :: ExpQ -> ExpQ -> RangeQ
-fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
-
-fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
-fromThenToR x y z = do { a <- x; b <- y; c <- z;
-                         return (FromThenToR a b c) }
--------------------------------------------------------------------------------
--- *   Body
-
-normalB :: ExpQ -> BodyQ
-normalB e = do { e1 <- e; return (NormalB e1) }
-
-guardedB :: [Q (Guard,Exp)] -> BodyQ
-guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
-
--------------------------------------------------------------------------------
--- *   Guard
-
-normalG :: ExpQ -> GuardQ
-normalG e = do { e1 <- e; return (NormalG e1) }
-
-normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
-normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
-
-patG :: [StmtQ] -> GuardQ
-patG ss = do { ss' <- sequence ss; return (PatG ss') }
-
-patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
-patGE ss e = do { ss' <- sequence ss;
-                  e'  <- e;
-                  return (PatG ss', e') }
-
--------------------------------------------------------------------------------
--- *   Match and Clause
-
--- | Use with 'caseE'
-match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
-match p rhs ds = do { p' <- p;
-                      r' <- rhs;
-                      ds' <- sequence ds;
-                      return (Match p' r' ds') }
-
--- | Use with 'funD'
-clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
-clause ps r ds = do { ps' <- sequence ps;
-                      r' <- r;
-                      ds' <- sequence ds;
-                      return (Clause ps' r' ds') }
-
-
----------------------------------------------------------------------------
--- *   Exp
-
--- | Dynamically binding a variable (unhygenic)
-dyn :: String -> ExpQ
-dyn s = return (VarE (mkName s))
-
-varE :: Name -> ExpQ
-varE s = return (VarE s)
-
-conE :: Name -> ExpQ
-conE s =  return (ConE s)
-
-litE :: Lit -> ExpQ
-litE c = return (LitE c)
-
-appE :: ExpQ -> ExpQ -> ExpQ
-appE x y = do { a <- x; b <- y; return (AppE a b)}
-
-appTypeE :: ExpQ -> TypeQ -> ExpQ
-appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
-
-parensE :: ExpQ -> ExpQ
-parensE x = do { x' <- x; return (ParensE x') }
-
-uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
-                     return (UInfixE x' s' y') }
-
-infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
-infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
-                                  return (InfixE (Just a) s' (Just b))}
-infixE Nothing  s (Just y) = do { s' <- s; b <- y;
-                                  return (InfixE Nothing s' (Just b))}
-infixE (Just x) s Nothing  = do { a <- x; s' <- s;
-                                  return (InfixE (Just a) s' Nothing)}
-infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }
-
-infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-infixApp x y z = infixE (Just x) y (Just z)
-sectionL :: ExpQ -> ExpQ -> ExpQ
-sectionL x y = infixE (Just x) y Nothing
-sectionR :: ExpQ -> ExpQ -> ExpQ
-sectionR x y = infixE Nothing x (Just y)
-
-lamE :: [PatQ] -> ExpQ -> ExpQ
-lamE ps e = do ps' <- sequence ps
-               e' <- e
-               return (LamE ps' e')
-
--- | Single-arg lambda
-lam1E :: PatQ -> ExpQ -> ExpQ
-lam1E p e = lamE [p] e
-
-lamCaseE :: [MatchQ] -> ExpQ
-lamCaseE ms = sequence ms >>= return . LamCaseE
-
-tupE :: [ExpQ] -> ExpQ
-tupE es = do { es1 <- sequence es; return (TupE es1)}
-
-unboxedTupE :: [ExpQ] -> ExpQ
-unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
-
-unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
-unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
-
-condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
-
-multiIfE :: [Q (Guard, Exp)] -> ExpQ
-multiIfE alts = sequence alts >>= return . MultiIfE
-
-letE :: [DecQ] -> ExpQ -> ExpQ
-letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
-
-caseE :: ExpQ -> [MatchQ] -> ExpQ
-caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
-
-doE :: [StmtQ] -> ExpQ
-doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
-
-compE :: [StmtQ] -> ExpQ
-compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
-
-arithSeqE :: RangeQ -> ExpQ
-arithSeqE r = do { r' <- r; return (ArithSeqE r') }
-
-listE :: [ExpQ] -> ExpQ
-listE es = do { es1 <- sequence es; return (ListE es1) }
-
-sigE :: ExpQ -> TypeQ -> ExpQ
-sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
-
-recConE :: Name -> [Q (Name,Exp)] -> ExpQ
-recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
-
-recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
-recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
-
-stringE :: String -> ExpQ
-stringE = litE . stringL
-
-fieldExp :: Name -> ExpQ -> Q (Name, Exp)
-fieldExp s e = do { e' <- e; return (s,e') }
-
--- | @staticE x = [| static x |]@
-staticE :: ExpQ -> ExpQ
-staticE = fmap StaticE
-
-unboundVarE :: Name -> ExpQ
-unboundVarE s = return (UnboundVarE s)
-
-labelE :: String -> ExpQ
-labelE s = return (LabelE s)
-
--- ** 'arithSeqE' Shortcuts
-fromE :: ExpQ -> ExpQ
-fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
-
-fromThenE :: ExpQ -> ExpQ -> ExpQ
-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
-
-fromToE :: ExpQ -> ExpQ -> ExpQ
-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
-
-fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
-fromThenToE x y z = do { a <- x; b <- y; c <- z;
-                         return (ArithSeqE (FromThenToR a b c)) }
-
+import Language.Haskell.TH.Lib.Internal hiding
+  ( tySynD
+  , dataD
+  , newtypeD
+  , classD
+  , dataInstD
+  , newtypeInstD
+  , dataFamilyD
+  , openTypeFamilyD
+  , closedTypeFamilyD
+  , forallC
+
+  , forallT
+  , sigT
+
+  , plainTV
+  , kindedTV
+  , starK
+  , constraintK
+
+  , noSig
+  , kindSig
+  , tyVarSig
+
+  , Role
+  , InjectivityAnn
+  )
+import Language.Haskell.TH.Syntax
+
+import Control.Monad (liftM2)
+
+-- All definitions below represent the "old" API, since their definitions are
+-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before
+-- deciding to change the APIs of the functions below, as they represent the
+-- public API (as opposed to the Internal module, which has no API promises.)
 
 -------------------------------------------------------------------------------
 -- *   Dec
 
-valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
-valD p b ds =
-  do { p' <- p
-     ; ds' <- sequence ds
-     ; b' <- b
-     ; return (ValD p' b' ds')
-     }
-
-funD :: Name -> [ClauseQ] -> DecQ
-funD nm cs =
- do { cs1 <- sequence cs
-    ; return (FunD nm cs1)
-    }
-
 tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ
 tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) }
 
@@ -491,78 +184,6 @@ classD ctxt cls tvs fds decs =
     ctxt1 <- ctxt
     return $ ClassD ctxt1 cls tvs fds decs1
 
-instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceD = instanceWithOverlapD Nothing
-
-instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
-instanceWithOverlapD o ctxt ty decs =
-  do
-    ctxt1 <- ctxt
-    decs1 <- sequence decs
-    ty1   <- ty
-    return $ InstanceD o ctxt1 ty1 decs1
-
-
-
-sigD :: Name -> TypeQ -> DecQ
-sigD fun ty = liftM (SigD fun) $ ty
-
-forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
-forImpD cc s str n ty
- = do ty' <- ty
-      return $ ForeignD (ImportF cc s str n ty')
-
-infixLD :: Int -> Name -> DecQ
-infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
-
-infixRD :: Int -> Name -> DecQ
-infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
-
-infixND :: Int -> Name -> DecQ
-infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
-
-pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
-pragInlD name inline rm phases
-  = return $ PragmaD $ InlineP name inline rm phases
-
-pragSpecD :: Name -> TypeQ -> Phases -> DecQ
-pragSpecD n ty phases
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
-
-pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
-pragSpecInlD n ty inline phases
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
-
-pragSpecInstD :: TypeQ -> DecQ
-pragSpecInstD ty
-  = do
-      ty1    <- ty
-      return $ PragmaD $ SpecialiseInstP ty1
-
-pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
-pragRuleD n bndrs lhs rhs phases
-  = do
-      bndrs1 <- sequence bndrs
-      lhs1   <- lhs
-      rhs1   <- rhs
-      return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
-
-pragAnnD :: AnnTarget -> ExpQ -> DecQ
-pragAnnD target expr
-  = do
-      exp1 <- expr
-      return $ PragmaD $ AnnP target exp1
-
-pragLineD :: Int -> String -> DecQ
-pragLineD line file = return $ PragmaD $ LineP line file
-
-pragCompleteD :: [Name] -> Maybe Name -> DecQ
-pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
-
 dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]
           -> DecQ
 dataInstD ctxt tc tys ksig cons derivs =
@@ -583,12 +204,6 @@ newtypeInstD ctxt tc tys ksig con derivs =
     derivs1 <- sequence derivs
     return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1)
 
-tySynInstD :: Name -> TySynEqnQ -> DecQ
-tySynInstD tc eqn =
-  do
-    eqn1 <- eqn
-    return (TySynInstD tc eqn1)
-
 dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ
 dataFamilyD tc tvs kind
     = return $ DataFamilyD tc tvs kind
@@ -604,112 +219,9 @@ closedTypeFamilyD tc tvs result injectivity eqns =
   do eqns1 <- sequence eqns
      return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)
 
--- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you
--- remove this check please also:
---   1. remove deprecated functions
---   2. remove CPP language extension from top of this module
---   3. remove the FamFlavour data type from Syntax module
---   4. make sure that all references to FamFlavour are gone from DsMeta,
---      Convert, TcSplice (follows from 3)
-#if __GLASGOW_HASKELL__ >= 804
-#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
-#endif
-
-{-# DEPRECATED familyNoKindD, familyKindD
-               "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
-familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
-familyNoKindD flav tc tvs =
-    case flav of
-      TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
-      DataFam -> return $ DataFamilyD tc tvs Nothing
-
-familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
-familyKindD flav tc tvs k =
-    case flav of
-      TypeFam ->
-        return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
-      DataFam -> return $ DataFamilyD tc tvs (Just k)
-
-{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
-               "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
-closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
-closedTypeFamilyNoKindD tc tvs eqns =
- do eqns1 <- sequence eqns
-    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
-
-closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
-closedTypeFamilyKindD tc tvs kind eqns =
- do eqns1 <- sequence eqns
-    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
-            eqns1)
-
-roleAnnotD :: Name -> [Role] -> DecQ
-roleAnnotD name roles = return $ RoleAnnotD name roles
-
-standaloneDerivD :: CxtQ -> TypeQ -> DecQ
-standaloneDerivD = standaloneDerivWithStrategyD Nothing
-
-standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
-standaloneDerivWithStrategyD ds ctxtq tyq =
-  do
-    ctxt <- ctxtq
-    ty   <- tyq
-    return $ StandaloneDerivD ds ctxt ty
-
-defaultSigD :: Name -> TypeQ -> DecQ
-defaultSigD n tyq =
-  do
-    ty <- tyq
-    return $ DefaultSigD n ty
-
--- | Pattern synonym declaration
-patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
-patSynD name args dir pat = do
-  args'    <- args
-  dir'     <- dir
-  pat'     <- pat
-  return (PatSynD name args' dir' pat')
-
--- | Pattern synonym type signature
-patSynSigD :: Name -> TypeQ -> DecQ
-patSynSigD nm ty =
-  do ty' <- ty
-     return $ PatSynSigD nm ty'
-
-tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
-tySynEqn lhs rhs =
-  do
-    lhs1 <- sequence lhs
-    rhs1 <- rhs
-    return (TySynEqn lhs1 rhs1)
-
-cxt :: [PredQ] -> CxtQ
-cxt = sequence
-
-derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
-derivClause ds p = do p' <- cxt p
-                      return $ DerivClause ds p'
-
-normalC :: Name -> [BangTypeQ] -> ConQ
-normalC con strtys = liftM (NormalC con) $ sequence strtys
-
-recC :: Name -> [VarBangTypeQ] -> ConQ
-recC con varstrtys = liftM (RecC con) $ sequence varstrtys
-
-infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
-infixC st1 con st2 = do st1' <- st1
-                        st2' <- st2
-                        return $ InfixC st1' con st2'
-
 forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ
 forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
 
-gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ
-gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty
-
-recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
-recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
-
 -------------------------------------------------------------------------------
 -- *   Type
 
@@ -719,145 +231,12 @@ forallT tvars ctxt ty = do
     ty1   <- ty
     return $ ForallT tvars ctxt1 ty1
 
-varT :: Name -> TypeQ
-varT = return . VarT
-
-conT :: Name -> TypeQ
-conT = return . ConT
-
-infixT :: TypeQ -> Name -> TypeQ -> TypeQ
-infixT t1 n t2 = do t1' <- t1
-                    t2' <- t2
-                    return (InfixT t1' n t2')
-
-uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
-uInfixT t1 n t2 = do t1' <- t1
-                     t2' <- t2
-                     return (UInfixT t1' n t2')
-
-parensT :: TypeQ -> TypeQ
-parensT t = do t' <- t
-               return (ParensT t')
-
-appT :: TypeQ -> TypeQ -> TypeQ
-appT t1 t2 = do
-           t1' <- t1
-           t2' <- t2
-           return $ AppT t1' t2'
-
-arrowT :: TypeQ
-arrowT = return ArrowT
-
-listT :: TypeQ
-listT = return ListT
-
-litT :: TyLitQ -> TypeQ
-litT l = fmap LitT l
-
-tupleT :: Int -> TypeQ
-tupleT i = return (TupleT i)
-
-unboxedTupleT :: Int -> TypeQ
-unboxedTupleT i = return (UnboxedTupleT i)
-
-unboxedSumT :: SumArity -> TypeQ
-unboxedSumT arity = return (UnboxedSumT arity)
-
 sigT :: TypeQ -> Kind -> TypeQ
 sigT t k
   = do
       t' <- t
       return $ SigT t' k
 
-equalityT :: TypeQ
-equalityT = return EqualityT
-
-wildCardT :: TypeQ
-wildCardT = return WildCardT
-
-{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
-classP :: Name -> [Q Type] -> Q Pred
-classP cla tys
-  = do
-      tysl <- sequence tys
-      return (foldl AppT (ConT cla) tysl)
-
-{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
-equalP :: TypeQ -> TypeQ -> PredQ
-equalP tleft tright
-  = do
-      tleft1  <- tleft
-      tright1 <- tright
-      eqT <- equalityT
-      return (foldl AppT eqT [tleft1, tright1])
-
-promotedT :: Name -> TypeQ
-promotedT = return . PromotedT
-
-promotedTupleT :: Int -> TypeQ
-promotedTupleT i = return (PromotedTupleT i)
-
-promotedNilT :: TypeQ
-promotedNilT = return PromotedNilT
-
-promotedConsT :: TypeQ
-promotedConsT = return PromotedConsT
-
-noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
-noSourceUnpackedness = return NoSourceUnpackedness
-sourceNoUnpack       = return SourceNoUnpack
-sourceUnpack         = return SourceUnpack
-
-noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
-noSourceStrictness = return NoSourceStrictness
-sourceLazy         = return SourceLazy
-sourceStrict       = return SourceStrict
-
-{-# DEPRECATED isStrict
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
-{-# DEPRECATED notStrict
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
-{-# DEPRECATED unpacked
-    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
-     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
-isStrict, notStrict, unpacked :: Q Strict
-isStrict = bang noSourceUnpackedness sourceStrict
-notStrict = bang noSourceUnpackedness noSourceStrictness
-unpacked = bang sourceUnpack sourceStrict
-
-bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
-bang u s = do u' <- u
-              s' <- s
-              return (Bang u' s')
-
-bangType :: BangQ -> TypeQ -> BangTypeQ
-bangType = liftM2 (,)
-
-varBangType :: Name -> BangTypeQ -> VarBangTypeQ
-varBangType v bt = do (b, t) <- bt
-                      return (v, b, t)
-
-{-# DEPRECATED strictType
-               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
-strictType :: Q Strict -> TypeQ -> StrictTypeQ
-strictType = bangType
-
-{-# DEPRECATED varStrictType
-               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
-varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
-varStrictType = varBangType
-
--- * Type Literals
-
-numTyLit :: Integer -> TyLitQ
-numTyLit n = if n >= 0 then return (NumTyLit n)
-                       else fail ("Negative type-level number: " ++ show n)
-
-strTyLit :: String -> TyLitQ
-strTyLit s = return (StrTyLit s)
-
 -------------------------------------------------------------------------------
 -- *   Kind
 
@@ -867,24 +246,6 @@ plainTV = PlainTV
 kindedTV :: Name -> Kind -> TyVarBndr
 kindedTV = KindedTV
 
-varK :: Name -> Kind
-varK = VarT
-
-conK :: Name -> Kind
-conK = ConT
-
-tupleK :: Int -> Kind
-tupleK = TupleT
-
-arrowK :: Kind
-arrowK = ArrowT
-
-listK :: Kind
-listK = ListT
-
-appK :: Kind -> Kind -> Kind
-appK = AppT
-
 starK :: Kind
 starK = StarT
 
@@ -902,104 +263,3 @@ kindSig = KindSig
 
 tyVarSig :: TyVarBndr -> FamilyResultSig
 tyVarSig = TyVarSig
-
--------------------------------------------------------------------------------
--- *   Injectivity annotation
-
-injectivityAnn :: Name -> [Name] -> InjectivityAnn
-injectivityAnn = TH.InjectivityAnn
-
--------------------------------------------------------------------------------
--- *   Role
-
-nominalR, representationalR, phantomR, inferR :: Role
-nominalR          = NominalR
-representationalR = RepresentationalR
-phantomR          = PhantomR
-inferR            = InferR
-
--------------------------------------------------------------------------------
--- *   Callconv
-
-cCall, stdCall, cApi, prim, javaScript :: Callconv
-cCall      = CCall
-stdCall    = StdCall
-cApi       = CApi
-prim       = Prim
-javaScript = JavaScript
-
--------------------------------------------------------------------------------
--- *   Safety
-
-unsafe, safe, interruptible :: Safety
-unsafe = Unsafe
-safe = Safe
-interruptible = Interruptible
-
--------------------------------------------------------------------------------
--- *   FunDep
-
-funDep :: [Name] -> [Name] -> FunDep
-funDep = FunDep
-
--------------------------------------------------------------------------------
--- *   FamFlavour
-
-typeFam, dataFam :: FamFlavour
-typeFam = TypeFam
-dataFam = DataFam
-
--------------------------------------------------------------------------------
--- *   RuleBndr
-ruleVar :: Name -> RuleBndrQ
-ruleVar = return . RuleVar
-
-typedRuleVar :: Name -> TypeQ -> RuleBndrQ
-typedRuleVar n ty = ty >>= return . TypedRuleVar n
-
--------------------------------------------------------------------------------
--- *   AnnTarget
-valueAnnotation :: Name -> AnnTarget
-valueAnnotation = ValueAnnotation
-
-typeAnnotation :: Name -> AnnTarget
-typeAnnotation = TypeAnnotation
-
-moduleAnnotation :: AnnTarget
-moduleAnnotation = ModuleAnnotation
-
--------------------------------------------------------------------------------
--- * Pattern Synonyms (sub constructs)
-
-unidir, implBidir :: PatSynDirQ
-unidir    = return Unidir
-implBidir = return ImplBidir
-
-explBidir :: [ClauseQ] -> PatSynDirQ
-explBidir cls = do
-  cls' <- sequence cls
-  return (ExplBidir cls')
-
-prefixPatSyn :: [Name] -> PatSynArgsQ
-prefixPatSyn args = return $ PrefixPatSyn args
-
-recordPatSyn :: [Name] -> PatSynArgsQ
-recordPatSyn sels = return $ RecordPatSyn sels
-
-infixPatSyn :: Name -> Name -> PatSynArgsQ
-infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
-
---------------------------------------------------------------
--- * Useful helper function
-
-appsE :: [ExpQ] -> ExpQ
-appsE [] = error "appsE []"
-appsE [x] = x
-appsE (x:y:zs) = appsE ( (appE x y) : zs )
-
--- | Return the Module at the place of splicing.  Can be used as an
--- input for 'reifyModule'.
-thisModule :: Q Module
-thisModule = do
-  loc <- location
-  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
new file mode 100644
index 0000000000..d58ce84f99
--- /dev/null
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -0,0 +1,936 @@
+-- |
+-- Language.Haskell.TH.Lib.Internal exposes some additional functionality that
+-- is used internally in GHC's integration with Template Haskell. This is not a
+-- part of the public API, and as such, there are no API guarantees for this
+-- module from version to version.
+
+-- Why do we have both Language.Haskell.TH.Lib.Internal and
+-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
+-- former (which are tailored for GHC's use) need different type signatures
+-- than the ones in the latter. Syncing up the Internal type signatures would
+-- involve a massive amount of breaking changes, so for the time being, we
+-- relegate as many changes as we can to just the Internal module, where it
+-- is safe to break things.
+
+{-# LANGUAGE CPP #-}
+
+module Language.Haskell.TH.Lib.Internal where
+
+import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
+import qualified Language.Haskell.TH.Syntax as TH
+import Control.Monad( liftM, liftM2 )
+import Data.Word( Word8 )
+
+----------------------------------------------------------
+-- * Type synonyms
+----------------------------------------------------------
+
+type InfoQ               = Q Info
+type PatQ                = Q Pat
+type FieldPatQ           = Q FieldPat
+type ExpQ                = Q Exp
+type TExpQ a             = Q (TExp a)
+type DecQ                = Q Dec
+type DecsQ               = Q [Dec]
+type ConQ                = Q Con
+type TypeQ               = Q Type
+type KindQ               = Q Kind
+type TyVarBndrQ          = Q TyVarBndr
+type TyLitQ              = Q TyLit
+type CxtQ                = Q Cxt
+type PredQ               = Q Pred
+type DerivClauseQ        = Q DerivClause
+type MatchQ              = Q Match
+type ClauseQ             = Q Clause
+type BodyQ               = Q Body
+type GuardQ              = Q Guard
+type StmtQ               = Q Stmt
+type RangeQ              = Q Range
+type SourceStrictnessQ   = Q SourceStrictness
+type SourceUnpackednessQ = Q SourceUnpackedness
+type BangQ               = Q Bang
+type BangTypeQ           = Q BangType
+type VarBangTypeQ        = Q VarBangType
+type StrictTypeQ         = Q StrictType
+type VarStrictTypeQ      = Q VarStrictType
+type FieldExpQ           = Q FieldExp
+type RuleBndrQ           = Q RuleBndr
+type TySynEqnQ           = Q TySynEqn
+type PatSynDirQ          = Q PatSynDir
+type PatSynArgsQ         = Q PatSynArgs
+type FamilyResultSigQ    = Q FamilyResultSig
+
+-- must be defined here for DsMeta to find it
+type Role                = TH.Role
+type InjectivityAnn      = TH.InjectivityAnn
+
+----------------------------------------------------------
+-- * Lowercase pattern syntax functions
+----------------------------------------------------------
+
+intPrimL    :: Integer -> Lit
+intPrimL    = IntPrimL
+wordPrimL    :: Integer -> Lit
+wordPrimL    = WordPrimL
+floatPrimL  :: Rational -> Lit
+floatPrimL  = FloatPrimL
+doublePrimL :: Rational -> Lit
+doublePrimL = DoublePrimL
+integerL    :: Integer -> Lit
+integerL    = IntegerL
+charL       :: Char -> Lit
+charL       = CharL
+charPrimL   :: Char -> Lit
+charPrimL   = CharPrimL
+stringL     :: String -> Lit
+stringL     = StringL
+stringPrimL :: [Word8] -> Lit
+stringPrimL = StringPrimL
+rationalL   :: Rational -> Lit
+rationalL   = RationalL
+
+litP :: Lit -> PatQ
+litP l = return (LitP l)
+
+varP :: Name -> PatQ
+varP v = return (VarP v)
+
+tupP :: [PatQ] -> PatQ
+tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
+
+unboxedTupP :: [PatQ] -> PatQ
+unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
+
+unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
+unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
+
+conP :: Name -> [PatQ] -> PatQ
+conP n ps = do ps' <- sequence ps
+               return (ConP n ps')
+infixP :: PatQ -> Name -> PatQ -> PatQ
+infixP p1 n p2 = do p1' <- p1
+                    p2' <- p2
+                    return (InfixP p1' n p2')
+uInfixP :: PatQ -> Name -> PatQ -> PatQ
+uInfixP p1 n p2 = do p1' <- p1
+                     p2' <- p2
+                     return (UInfixP p1' n p2')
+parensP :: PatQ -> PatQ
+parensP p = do p' <- p
+               return (ParensP p')
+
+tildeP :: PatQ -> PatQ
+tildeP p = do p' <- p
+              return (TildeP p')
+bangP :: PatQ -> PatQ
+bangP p = do p' <- p
+             return (BangP p')
+asP :: Name -> PatQ -> PatQ
+asP n p = do p' <- p
+             return (AsP n p')
+wildP :: PatQ
+wildP = return WildP
+recP :: Name -> [FieldPatQ] -> PatQ
+recP n fps = do fps' <- sequence fps
+                return (RecP n fps')
+listP :: [PatQ] -> PatQ
+listP ps = do ps' <- sequence ps
+              return (ListP ps')
+sigP :: PatQ -> TypeQ -> PatQ
+sigP p t = do p' <- p
+              t' <- t
+              return (SigP p' t')
+viewP :: ExpQ -> PatQ -> PatQ
+viewP e p = do e' <- e
+               p' <- p
+               return (ViewP e' p')
+
+fieldPat :: Name -> PatQ -> FieldPatQ
+fieldPat n p = do p' <- p
+                  return (n, p')
+
+
+-------------------------------------------------------------------------------
+-- *   Stmt
+
+bindS :: PatQ -> ExpQ -> StmtQ
+bindS p e = liftM2 BindS p e
+
+letS :: [DecQ] -> StmtQ
+letS ds = do { ds1 <- sequence ds; return (LetS ds1) }
+
+noBindS :: ExpQ -> StmtQ
+noBindS e = do { e1 <- e; return (NoBindS e1) }
+
+parS :: [[StmtQ]] -> StmtQ
+parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) }
+
+-------------------------------------------------------------------------------
+-- *   Range
+
+fromR :: ExpQ -> RangeQ
+fromR x = do { a <- x; return (FromR a) }
+
+fromThenR :: ExpQ -> ExpQ -> RangeQ
+fromThenR x y = do { a <- x; b <- y; return (FromThenR a b) }
+
+fromToR :: ExpQ -> ExpQ -> RangeQ
+fromToR x y = do { a <- x; b <- y; return (FromToR a b) }
+
+fromThenToR :: ExpQ -> ExpQ -> ExpQ -> RangeQ
+fromThenToR x y z = do { a <- x; b <- y; c <- z;
+                         return (FromThenToR a b c) }
+-------------------------------------------------------------------------------
+-- *   Body
+
+normalB :: ExpQ -> BodyQ
+normalB e = do { e1 <- e; return (NormalB e1) }
+
+guardedB :: [Q (Guard,Exp)] -> BodyQ
+guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') }
+
+-------------------------------------------------------------------------------
+-- *   Guard
+
+normalG :: ExpQ -> GuardQ
+normalG e = do { e1 <- e; return (NormalG e1) }
+
+normalGE :: ExpQ -> ExpQ -> Q (Guard, Exp)
+normalGE g e = do { g1 <- g; e1 <- e; return (NormalG g1, e1) }
+
+patG :: [StmtQ] -> GuardQ
+patG ss = do { ss' <- sequence ss; return (PatG ss') }
+
+patGE :: [StmtQ] -> ExpQ -> Q (Guard, Exp)
+patGE ss e = do { ss' <- sequence ss;
+                  e'  <- e;
+                  return (PatG ss', e') }
+
+-------------------------------------------------------------------------------
+-- *   Match and Clause
+
+-- | Use with 'caseE'
+match :: PatQ -> BodyQ -> [DecQ] -> MatchQ
+match p rhs ds = do { p' <- p;
+                      r' <- rhs;
+                      ds' <- sequence ds;
+                      return (Match p' r' ds') }
+
+-- | Use with 'funD'
+clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ
+clause ps r ds = do { ps' <- sequence ps;
+                      r' <- r;
+                      ds' <- sequence ds;
+                      return (Clause ps' r' ds') }
+
+
+---------------------------------------------------------------------------
+-- *   Exp
+
+-- | Dynamically binding a variable (unhygenic)
+dyn :: String -> ExpQ
+dyn s = return (VarE (mkName s))
+
+varE :: Name -> ExpQ
+varE s = return (VarE s)
+
+conE :: Name -> ExpQ
+conE s =  return (ConE s)
+
+litE :: Lit -> ExpQ
+litE c = return (LitE c)
+
+appE :: ExpQ -> ExpQ -> ExpQ
+appE x y = do { a <- x; b <- y; return (AppE a b)}
+
+appTypeE :: ExpQ -> TypeQ -> ExpQ
+appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }
+
+parensE :: ExpQ -> ExpQ
+parensE x = do { x' <- x; return (ParensE x') }
+
+uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
+                     return (UInfixE x' s' y') }
+
+infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
+infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
+                                  return (InfixE (Just a) s' (Just b))}
+infixE Nothing  s (Just y) = do { s' <- s; b <- y;
+                                  return (InfixE Nothing s' (Just b))}
+infixE (Just x) s Nothing  = do { a <- x; s' <- s;
+                                  return (InfixE (Just a) s' Nothing)}
+infixE Nothing  s Nothing  = do { s' <- s; return (InfixE Nothing s' Nothing) }
+
+infixApp :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+infixApp x y z = infixE (Just x) y (Just z)
+sectionL :: ExpQ -> ExpQ -> ExpQ
+sectionL x y = infixE (Just x) y Nothing
+sectionR :: ExpQ -> ExpQ -> ExpQ
+sectionR x y = infixE Nothing x (Just y)
+
+lamE :: [PatQ] -> ExpQ -> ExpQ
+lamE ps e = do ps' <- sequence ps
+               e' <- e
+               return (LamE ps' e')
+
+-- | Single-arg lambda
+lam1E :: PatQ -> ExpQ -> ExpQ
+lam1E p e = lamE [p] e
+
+lamCaseE :: [MatchQ] -> ExpQ
+lamCaseE ms = sequence ms >>= return . LamCaseE
+
+tupE :: [ExpQ] -> ExpQ
+tupE es = do { es1 <- sequence es; return (TupE es1)}
+
+unboxedTupE :: [ExpQ] -> ExpQ
+unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
+
+unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
+unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
+
+condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
+
+multiIfE :: [Q (Guard, Exp)] -> ExpQ
+multiIfE alts = sequence alts >>= return . MultiIfE
+
+letE :: [DecQ] -> ExpQ -> ExpQ
+letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
+
+caseE :: ExpQ -> [MatchQ] -> ExpQ
+caseE e ms = do { e1 <- e; ms1 <- sequence ms; return (CaseE e1 ms1) }
+
+doE :: [StmtQ] -> ExpQ
+doE ss = do { ss1 <- sequence ss; return (DoE ss1) }
+
+compE :: [StmtQ] -> ExpQ
+compE ss = do { ss1 <- sequence ss; return (CompE ss1) }
+
+arithSeqE :: RangeQ -> ExpQ
+arithSeqE r = do { r' <- r; return (ArithSeqE r') }
+
+listE :: [ExpQ] -> ExpQ
+listE es = do { es1 <- sequence es; return (ListE es1) }
+
+sigE :: ExpQ -> TypeQ -> ExpQ
+sigE e t = do { e1 <- e; t1 <- t; return (SigE e1 t1) }
+
+recConE :: Name -> [Q (Name,Exp)] -> ExpQ
+recConE c fs = do { flds <- sequence fs; return (RecConE c flds) }
+
+recUpdE :: ExpQ -> [Q (Name,Exp)] -> ExpQ
+recUpdE e fs = do { e1 <- e; flds <- sequence fs; return (RecUpdE e1 flds) }
+
+stringE :: String -> ExpQ
+stringE = litE . stringL
+
+fieldExp :: Name -> ExpQ -> Q (Name, Exp)
+fieldExp s e = do { e' <- e; return (s,e') }
+
+-- | @staticE x = [| static x |]@
+staticE :: ExpQ -> ExpQ
+staticE = fmap StaticE
+
+unboundVarE :: Name -> ExpQ
+unboundVarE s = return (UnboundVarE s)
+
+labelE :: String -> ExpQ
+labelE s = return (LabelE s)
+
+-- ** 'arithSeqE' Shortcuts
+fromE :: ExpQ -> ExpQ
+fromE x = do { a <- x; return (ArithSeqE (FromR a)) }
+
+fromThenE :: ExpQ -> ExpQ -> ExpQ
+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) }
+
+fromToE :: ExpQ -> ExpQ -> ExpQ
+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) }
+
+fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+fromThenToE x y z = do { a <- x; b <- y; c <- z;
+                         return (ArithSeqE (FromThenToR a b c)) }
+
+
+-------------------------------------------------------------------------------
+-- *   Dec
+
+valD :: PatQ -> BodyQ -> [DecQ] -> DecQ
+valD p b ds =
+  do { p' <- p
+     ; ds' <- sequence ds
+     ; b' <- b
+     ; return (ValD p' b' ds')
+     }
+
+funD :: Name -> [ClauseQ] -> DecQ
+funD nm cs =
+ do { cs1 <- sequence cs
+    ; return (FunD nm cs1)
+    }
+
+tySynD :: Name -> [TyVarBndrQ] -> TypeQ -> DecQ
+tySynD tc tvs rhs =
+  do { tvs1 <- sequenceA tvs
+     ; rhs1 <- rhs
+     ; return (TySynD tc tvs1 rhs1)
+     }
+
+dataD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> [ConQ]
+      -> [DerivClauseQ] -> DecQ
+dataD ctxt tc tvs ksig cons derivs =
+  do
+    ctxt1   <- ctxt
+    tvs1    <- sequenceA tvs
+    ksig1   <- sequenceA ksig
+    cons1   <- sequence cons
+    derivs1 <- sequence derivs
+    return (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1)
+
+newtypeD :: CxtQ -> Name -> [TyVarBndrQ] -> Maybe KindQ -> ConQ
+         -> [DerivClauseQ] -> DecQ
+newtypeD ctxt tc tvs ksig con derivs =
+  do
+    ctxt1   <- ctxt
+    tvs1    <- sequenceA tvs
+    ksig1   <- sequenceA ksig
+    con1    <- con
+    derivs1 <- sequence derivs
+    return (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1)
+
+classD :: CxtQ -> Name -> [TyVarBndrQ] -> [FunDep] -> [DecQ] -> DecQ
+classD ctxt cls tvs fds decs =
+  do
+    tvs1  <- sequenceA tvs
+    decs1 <- sequenceA decs
+    ctxt1 <- ctxt
+    return $ ClassD ctxt1 cls tvs1 fds decs1
+
+instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceD = instanceWithOverlapD Nothing
+
+instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ
+instanceWithOverlapD o ctxt ty decs =
+  do
+    ctxt1 <- ctxt
+    decs1 <- sequence decs
+    ty1   <- ty
+    return $ InstanceD o ctxt1 ty1 decs1
+
+
+
+sigD :: Name -> TypeQ -> DecQ
+sigD fun ty = liftM (SigD fun) $ ty
+
+forImpD :: Callconv -> Safety -> String -> Name -> TypeQ -> DecQ
+forImpD cc s str n ty
+ = do ty' <- ty
+      return $ ForeignD (ImportF cc s str n ty')
+
+infixLD :: Int -> Name -> DecQ
+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)
+
+infixRD :: Int -> Name -> DecQ
+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)
+
+infixND :: Int -> Name -> DecQ
+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)
+
+pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ
+pragInlD name inline rm phases
+  = return $ PragmaD $ InlineP name inline rm phases
+
+pragSpecD :: Name -> TypeQ -> Phases -> DecQ
+pragSpecD n ty phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 Nothing phases
+
+pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ
+pragSpecInlD n ty inline phases
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases
+
+pragSpecInstD :: TypeQ -> DecQ
+pragSpecInstD ty
+  = do
+      ty1    <- ty
+      return $ PragmaD $ SpecialiseInstP ty1
+
+pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ
+pragRuleD n bndrs lhs rhs phases
+  = do
+      bndrs1 <- sequence bndrs
+      lhs1   <- lhs
+      rhs1   <- rhs
+      return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases
+
+pragAnnD :: AnnTarget -> ExpQ -> DecQ
+pragAnnD target expr
+  = do
+      exp1 <- expr
+      return $ PragmaD $ AnnP target exp1
+
+pragLineD :: Int -> String -> DecQ
+pragLineD line file = return $ PragmaD $ LineP line file
+
+pragCompleteD :: [Name] -> Maybe Name -> DecQ
+pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty
+
+dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> [ConQ]
+          -> [DerivClauseQ] -> DecQ
+dataInstD ctxt tc tys ksig cons derivs =
+  do
+    ctxt1   <- ctxt
+    tys1    <- sequenceA tys
+    ksig1   <- sequenceA ksig
+    cons1   <- sequenceA cons
+    derivs1 <- sequenceA derivs
+    return (DataInstD ctxt1 tc tys1 ksig1 cons1 derivs1)
+
+newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> ConQ
+             -> [DerivClauseQ] -> DecQ
+newtypeInstD ctxt tc tys ksig con derivs =
+  do
+    ctxt1   <- ctxt
+    tys1    <- sequenceA tys
+    ksig1   <- sequenceA ksig
+    con1    <- con
+    derivs1 <- sequence derivs
+    return (NewtypeInstD ctxt1 tc tys1 ksig1 con1 derivs1)
+
+tySynInstD :: Name -> TySynEqnQ -> DecQ
+tySynInstD tc eqn =
+  do
+    eqn1 <- eqn
+    return (TySynInstD tc eqn1)
+
+dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ
+dataFamilyD tc tvs kind =
+  do tvs'  <- sequenceA tvs
+     kind' <- sequenceA kind
+     return $ DataFamilyD tc tvs' kind'
+
+openTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
+                -> Maybe InjectivityAnn -> DecQ
+openTypeFamilyD tc tvs res inj =
+  do tvs' <- sequenceA tvs
+     res' <- res
+     return $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj)
+
+closedTypeFamilyD :: Name -> [TyVarBndrQ] -> FamilyResultSigQ
+                  -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ
+closedTypeFamilyD tc tvs result injectivity eqns =
+  do tvs1    <- sequenceA tvs
+     result1 <- result
+     eqns1   <- sequenceA eqns
+     return (ClosedTypeFamilyD (TypeFamilyHead tc tvs1 result1 injectivity) eqns1)
+
+-- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you
+-- remove this check please also:
+--   1. remove deprecated functions
+--   2. remove CPP language extension from top of this module
+--   3. remove the FamFlavour data type from Syntax module
+--   4. make sure that all references to FamFlavour are gone from DsMeta,
+--      Convert, TcSplice (follows from 3)
+#if __GLASGOW_HASKELL__ >= 804
+#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD
+#endif
+
+{-# DEPRECATED familyNoKindD, familyKindD
+               "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}
+familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ
+familyNoKindD flav tc tvs =
+    case flav of
+      TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)
+      DataFam -> return $ DataFamilyD tc tvs Nothing
+
+familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ
+familyKindD flav tc tvs k =
+    case flav of
+      TypeFam ->
+        return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)
+      DataFam -> return $ DataFamilyD tc tvs (Just k)
+
+{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD
+               "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-}
+closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ
+closedTypeFamilyNoKindD tc tvs eqns =
+ do eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1)
+
+closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ
+closedTypeFamilyKindD tc tvs kind eqns =
+ do eqns1 <- sequence eqns
+    return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)
+            eqns1)
+
+roleAnnotD :: Name -> [Role] -> DecQ
+roleAnnotD name roles = return $ RoleAnnotD name roles
+
+standaloneDerivD :: CxtQ -> TypeQ -> DecQ
+standaloneDerivD = standaloneDerivWithStrategyD Nothing
+
+standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ
+standaloneDerivWithStrategyD ds ctxtq tyq =
+  do
+    ctxt <- ctxtq
+    ty   <- tyq
+    return $ StandaloneDerivD ds ctxt ty
+
+defaultSigD :: Name -> TypeQ -> DecQ
+defaultSigD n tyq =
+  do
+    ty <- tyq
+    return $ DefaultSigD n ty
+
+-- | Pattern synonym declaration
+patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ
+patSynD name args dir pat = do
+  args'    <- args
+  dir'     <- dir
+  pat'     <- pat
+  return (PatSynD name args' dir' pat')
+
+-- | Pattern synonym type signature
+patSynSigD :: Name -> TypeQ -> DecQ
+patSynSigD nm ty =
+  do ty' <- ty
+     return $ PatSynSigD nm ty'
+
+tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ
+tySynEqn lhs rhs =
+  do
+    lhs1 <- sequence lhs
+    rhs1 <- rhs
+    return (TySynEqn lhs1 rhs1)
+
+cxt :: [PredQ] -> CxtQ
+cxt = sequence
+
+derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ
+derivClause ds p = do p' <- cxt p
+                      return $ DerivClause ds p'
+
+normalC :: Name -> [BangTypeQ] -> ConQ
+normalC con strtys = liftM (NormalC con) $ sequence strtys
+
+recC :: Name -> [VarBangTypeQ] -> ConQ
+recC con varstrtys = liftM (RecC con) $ sequence varstrtys
+
+infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ
+infixC st1 con st2 = do st1' <- st1
+                        st2' <- st2
+                        return $ InfixC st1' con st2'
+
+forallC :: [TyVarBndrQ] -> CxtQ -> ConQ -> ConQ
+forallC ns ctxt con = do
+  ns'   <- sequenceA ns
+  ctxt' <- ctxt
+  con'  <- con
+  pure $ ForallC ns' ctxt' con'
+
+gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ
+gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty
+
+recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ
+recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty
+
+-------------------------------------------------------------------------------
+-- *   Type
+
+forallT :: [TyVarBndrQ] -> CxtQ -> TypeQ -> TypeQ
+forallT tvars ctxt ty = do
+    tvars1 <- sequenceA tvars
+    ctxt1  <- ctxt
+    ty1    <- ty
+    return $ ForallT tvars1 ctxt1 ty1
+
+varT :: Name -> TypeQ
+varT = return . VarT
+
+conT :: Name -> TypeQ
+conT = return . ConT
+
+infixT :: TypeQ -> Name -> TypeQ -> TypeQ
+infixT t1 n t2 = do t1' <- t1
+                    t2' <- t2
+                    return (InfixT t1' n t2')
+
+uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ
+uInfixT t1 n t2 = do t1' <- t1
+                     t2' <- t2
+                     return (UInfixT t1' n t2')
+
+parensT :: TypeQ -> TypeQ
+parensT t = do t' <- t
+               return (ParensT t')
+
+appT :: TypeQ -> TypeQ -> TypeQ
+appT t1 t2 = do
+           t1' <- t1
+           t2' <- t2
+           return $ AppT t1' t2'
+
+arrowT :: TypeQ
+arrowT = return ArrowT
+
+listT :: TypeQ
+listT = return ListT
+
+litT :: TyLitQ -> TypeQ
+litT l = fmap LitT l
+
+tupleT :: Int -> TypeQ
+tupleT i = return (TupleT i)
+
+unboxedTupleT :: Int -> TypeQ
+unboxedTupleT i = return (UnboxedTupleT i)
+
+unboxedSumT :: SumArity -> TypeQ
+unboxedSumT arity = return (UnboxedSumT arity)
+
+sigT :: TypeQ -> KindQ -> TypeQ
+sigT t k
+  = do
+      t' <- t
+      k' <- k
+      return $ SigT t' k'
+
+equalityT :: TypeQ
+equalityT = return EqualityT
+
+wildCardT :: TypeQ
+wildCardT = return WildCardT
+
+{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
+classP :: Name -> [Q Type] -> Q Pred
+classP cla tys
+  = do
+      tysl <- sequence tys
+      return (foldl AppT (ConT cla) tysl)
+
+{-# DEPRECATED equalP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please see 'equalityT'." #-}
+equalP :: TypeQ -> TypeQ -> PredQ
+equalP tleft tright
+  = do
+      tleft1  <- tleft
+      tright1 <- tright
+      eqT <- equalityT
+      return (foldl AppT eqT [tleft1, tright1])
+
+promotedT :: Name -> TypeQ
+promotedT = return . PromotedT
+
+promotedTupleT :: Int -> TypeQ
+promotedTupleT i = return (PromotedTupleT i)
+
+promotedNilT :: TypeQ
+promotedNilT = return PromotedNilT
+
+promotedConsT :: TypeQ
+promotedConsT = return PromotedConsT
+
+noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ
+noSourceUnpackedness = return NoSourceUnpackedness
+sourceNoUnpack       = return SourceNoUnpack
+sourceUnpack         = return SourceUnpack
+
+noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ
+noSourceStrictness = return NoSourceStrictness
+sourceLazy         = return SourceLazy
+sourceStrict       = return SourceStrict
+
+{-# DEPRECATED isStrict
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}
+{-# DEPRECATED notStrict
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}
+{-# DEPRECATED unpacked
+    ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",
+     "Example usage: 'bang sourceUnpack sourceStrict'"] #-}
+isStrict, notStrict, unpacked :: Q Strict
+isStrict = bang noSourceUnpackedness sourceStrict
+notStrict = bang noSourceUnpackedness noSourceStrictness
+unpacked = bang sourceUnpack sourceStrict
+
+bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ
+bang u s = do u' <- u
+              s' <- s
+              return (Bang u' s')
+
+bangType :: BangQ -> TypeQ -> BangTypeQ
+bangType = liftM2 (,)
+
+varBangType :: Name -> BangTypeQ -> VarBangTypeQ
+varBangType v bt = do (b, t) <- bt
+                      return (v, b, t)
+
+{-# DEPRECATED strictType
+               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-}
+strictType :: Q Strict -> TypeQ -> StrictTypeQ
+strictType = bangType
+
+{-# DEPRECATED varStrictType
+               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-}
+varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
+varStrictType = varBangType
+
+-- * Type Literals
+
+numTyLit :: Integer -> TyLitQ
+numTyLit n = if n >= 0 then return (NumTyLit n)
+                       else fail ("Negative type-level number: " ++ show n)
+
+strTyLit :: String -> TyLitQ
+strTyLit s = return (StrTyLit s)
+
+-------------------------------------------------------------------------------
+-- *   Kind
+
+plainTV :: Name -> TyVarBndrQ
+plainTV = pure . PlainTV
+
+kindedTV :: Name -> KindQ -> TyVarBndrQ
+kindedTV n = fmap (KindedTV n)
+
+varK :: Name -> Kind
+varK = VarT
+
+conK :: Name -> Kind
+conK = ConT
+
+tupleK :: Int -> Kind
+tupleK = TupleT
+
+arrowK :: Kind
+arrowK = ArrowT
+
+listK :: Kind
+listK = ListT
+
+appK :: Kind -> Kind -> Kind
+appK = AppT
+
+starK :: KindQ
+starK = pure StarT
+
+constraintK :: KindQ
+constraintK = pure ConstraintT
+
+-------------------------------------------------------------------------------
+-- *   Type family result
+
+noSig :: FamilyResultSigQ
+noSig = pure NoSig
+
+kindSig :: KindQ -> FamilyResultSigQ
+kindSig = fmap KindSig
+
+tyVarSig :: TyVarBndrQ -> FamilyResultSigQ
+tyVarSig = fmap TyVarSig
+
+-------------------------------------------------------------------------------
+-- *   Injectivity annotation
+
+injectivityAnn :: Name -> [Name] -> InjectivityAnn
+injectivityAnn = TH.InjectivityAnn
+
+-------------------------------------------------------------------------------
+-- *   Role
+
+nominalR, representationalR, phantomR, inferR :: Role
+nominalR          = NominalR
+representationalR = RepresentationalR
+phantomR          = PhantomR
+inferR            = InferR
+
+-------------------------------------------------------------------------------
+-- *   Callconv
+
+cCall, stdCall, cApi, prim, javaScript :: Callconv
+cCall      = CCall
+stdCall    = StdCall
+cApi       = CApi
+prim       = Prim
+javaScript = JavaScript
+
+-------------------------------------------------------------------------------
+-- *   Safety
+
+unsafe, safe, interruptible :: Safety
+unsafe = Unsafe
+safe = Safe
+interruptible = Interruptible
+
+-------------------------------------------------------------------------------
+-- *   FunDep
+
+funDep :: [Name] -> [Name] -> FunDep
+funDep = FunDep
+
+-------------------------------------------------------------------------------
+-- *   FamFlavour
+
+typeFam, dataFam :: FamFlavour
+typeFam = TypeFam
+dataFam = DataFam
+
+-------------------------------------------------------------------------------
+-- *   RuleBndr
+ruleVar :: Name -> RuleBndrQ
+ruleVar = return . RuleVar
+
+typedRuleVar :: Name -> TypeQ -> RuleBndrQ
+typedRuleVar n ty = ty >>= return . TypedRuleVar n
+
+-------------------------------------------------------------------------------
+-- *   AnnTarget
+valueAnnotation :: Name -> AnnTarget
+valueAnnotation = ValueAnnotation
+
+typeAnnotation :: Name -> AnnTarget
+typeAnnotation = TypeAnnotation
+
+moduleAnnotation :: AnnTarget
+moduleAnnotation = ModuleAnnotation
+
+-------------------------------------------------------------------------------
+-- * Pattern Synonyms (sub constructs)
+
+unidir, implBidir :: PatSynDirQ
+unidir    = return Unidir
+implBidir = return ImplBidir
+
+explBidir :: [ClauseQ] -> PatSynDirQ
+explBidir cls = do
+  cls' <- sequence cls
+  return (ExplBidir cls')
+
+prefixPatSyn :: [Name] -> PatSynArgsQ
+prefixPatSyn args = return $ PrefixPatSyn args
+
+recordPatSyn :: [Name] -> PatSynArgsQ
+recordPatSyn sels = return $ RecordPatSyn sels
+
+infixPatSyn :: Name -> Name -> PatSynArgsQ
+infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2
+
+--------------------------------------------------------------
+-- * Useful helper function
+
+appsE :: [ExpQ] -> ExpQ
+appsE [] = error "appsE []"
+appsE [x] = x
+appsE (x:y:zs) = appsE ( (appE x y) : zs )
+
+-- | Return the Module at the place of splicing.  Can be used as an
+-- input for 'reifyModule'.
+thisModule :: Q Module
+thisModule = do
+  loc <- location
+  return $ Module (mkPkgName $ loc_package loc) (mkModName $ loc_module loc)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 696c4454c7..e6c33029ab 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -689,11 +689,11 @@ pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar
 pprParendType ArrowT              = parens (text "->")
 pprParendType ListT               = text "[]"
 pprParendType (LitT l)            = pprTyLit l
-pprParendType (PromotedT c)       = text "'" <> ppr c
+pprParendType (PromotedT c)       = text "'" <> pprName' Applied c
 pprParendType (PromotedTupleT 0)  = text "'()"
 pprParendType (PromotedTupleT n)  = quoteParens (hcat (replicate (n-1) comma))
 pprParendType PromotedNilT        = text "'[]"
-pprParendType PromotedConsT       = text "(':)"
+pprParendType PromotedConsT       = text "'(:)"
 pprParendType StarT               = char '*'
 pprParendType ConstraintT         = text "Constraint"
 pprParendType (SigT ty k)         = parens (ppr ty <+> text "::" <+> ppr k)
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 14aeaeb380..b8e1601456 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1,14 +1,10 @@
-{-# LANGUAGE CPP, DeriveDataTypeable,
+{-# LANGUAGE DeriveDataTypeable,
              DeriveGeneric, FlexibleInstances, DefaultSignatures,
              RankNTypes, RoleAnnotations, ScopedTypeVariables,
              Trustworthy #-}
 
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
 
-#if MIN_VERSION_base(4,9,0)
-# define HAS_MONADFAIL 1
-#endif
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Language.Haskell.Syntax
@@ -34,6 +30,7 @@ import Data.Data hiding (Fixity(..))
 import Data.IORef
 import System.IO.Unsafe ( unsafePerformIO )
 import Control.Monad (liftM)
+import Control.Monad.IO.Class (MonadIO (..))
 import System.IO        ( hPutStrLn, stderr )
 import Data.Char        ( isAlpha, isAlphaNum, isUpper )
 import Data.Int
@@ -45,9 +42,7 @@ import GHC.ForeignSrcLang.Type
 import Language.Haskell.TH.LanguageExtensions
 import Numeric.Natural
 
-#if HAS_MONADFAIL
 import qualified Control.Monad.Fail as Fail
-#endif
 
 -----------------------------------------------------
 --
@@ -55,11 +50,7 @@ import qualified Control.Monad.Fail as Fail
 --
 -----------------------------------------------------
 
-#if HAS_MONADFAIL
-class Fail.MonadFail m => Quasi m where
-#else
-class Monad m => Quasi m where
-#endif
+class (MonadIO m, Fail.MonadFail m) => Quasi m where
   qNewName :: String -> m Name
         -- ^ Fresh names
 
@@ -88,6 +79,7 @@ class Monad m => Quasi m where
   qLocation :: m Loc
 
   qRunIO :: IO a -> m a
+  qRunIO = liftIO
   -- ^ Input/output (dangerous)
 
   qAddDependentFile :: FilePath -> m ()
@@ -142,8 +134,6 @@ instance Quasi IO where
   qIsExtEnabled _       = badIO "isExtEnabled"
   qExtsEnabled          = badIO "extsEnabled"
 
-  qRunIO m = m
-
 badIO :: String -> IO a
 badIO op = do   { qReport True ("Can't do `" ++ op ++ "' in the IO monad")
                 ; fail "Template Haskell failure" }
@@ -179,14 +169,10 @@ runQ (Q m) = m
 instance Monad Q where
   Q m >>= k  = Q (m >>= \x -> unQ (k x))
   (>>) = (*>)
-#if !HAS_MONADFAIL
-  fail s     = report True s >> Q (fail "Q monad failure")
-#else
   fail       = Fail.fail
 
 instance Fail.MonadFail Q where
   fail s     = report True s >> Q (Fail.fail "Q monad failure")
-#endif
 
 instance Functor Q where
   fmap f (Q x) = Q (fmap f x)
@@ -508,6 +494,9 @@ isExtEnabled ext = Q (qIsExtEnabled ext)
 extsEnabled :: Q [Extension]
 extsEnabled = Q qExtsEnabled
 
+instance MonadIO Q where
+  liftIO = runIO
+
 instance Quasi Q where
   qNewName            = newName
   qReport             = report
@@ -521,7 +510,6 @@ instance Quasi Q where
   qReifyConStrictness = reifyConStrictness
   qLookupName         = lookupName
   qLocation           = location
-  qRunIO              = runIO
   qAddDependentFile   = addDependentFile
   qAddTopDecls        = addTopDecls
   qAddForeignFile     = addForeignFile
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 8eddedce3d..e003f1b47e 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -6,6 +6,19 @@
 
   * Add support for overloaded labels. Introduces `labelE :: String -> ExpQ`.
 
+  * Add `KindQ`, `TyVarBndrQ`, and `FamilyResultSigQ` aliases to
+    `Language.Haskell.TH.Lib`.
+
+  * Add `Language.Haskell.TH.Lib.Internal` module, which exposes some
+    additional functionality that is used internally in GHC's integration
+    with Template Haskell. This is not a part of the public API, and as
+    such, there are no API guarantees for this module from version to version.
+
+  * `MonadIO` is now a superclass of `Quasi`, `qRunIO` has a default
+    implementation `qRunIO = liftIO`
+
+  * Add `MonadIO Q` instance
+
 ## 2.12.0.0 *TBA*
 
   * Bundled with GHC *TBA*
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index dfb3b079b3..fcfa448b91 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -45,6 +45,8 @@ Library
         Language.Haskell.TH.Syntax
         Language.Haskell.TH.LanguageExtensions
 
+        Language.Haskell.TH.Lib.Internal
+
     other-modules:
         Language.Haskell.TH.Lib.Map
 
diff --git a/libraries/text b/libraries/text
new file mode 160000
+Subproject 81f9de11424b79e075d0d22cee23ce9ad90b506
diff --git a/libraries/unix b/libraries/unix
-Subproject fcaa530a8fdd3897353bdf246752a91d675aad4
+Subproject 063aea3fbc5a8caa03d0deb9a887763006ab86d
diff --git a/mk/warnings.mk b/mk/warnings.mk
index af5f4f51d9..16d13a28ba 100644
--- a/mk/warnings.mk
+++ b/mk/warnings.mk
@@ -114,6 +114,11 @@ libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-unused-matches -Wno-un
 libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-redundant-constraints
 libraries/transformers_dist-install_EXTRA_HC_OPTS += -Wno-orphans
 
+# parsec has various warnings
+libraries/parsec_dist-install_EXTRA_HC_OPTS += -Wno-name-shadowing -Wno-unused-matches
+libraries/parsec_dist-install_EXTRA_HC_OPTS += -Wno-unused-do-bind -Wno-missing-signatures
+libraries/parsec_dist-install_EXTRA_HC_OPTS += -Wno-unused-imports -Wno-type-defaults
+
 # Turn of trustworthy-safe warning
 libraries/base_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe
 libraries/ghc-prim_dist-install_EXTRA_HC_OPTS += -Wno-trustworthy-safe
diff --git a/packages b/packages
index 6ee80712f2..a44e31687e 100644
--- a/packages
+++ b/packages
@@ -52,9 +52,12 @@ libraries/directory          -           -                               ssh://g
 libraries/filepath           -           -                               ssh://git@github.com/haskell/filepath.git
 libraries/haskeline          -           -                               https://github.com/judah/haskeline.git
 libraries/hpc                -           -                               -
+libraries/mtl                -           -                               https://github.com/ekmett/mtl.git
+libraries/parsec             -           -                               https://github.com/haskell/parsec.git
 libraries/pretty             -           -                               https://github.com/haskell/pretty.git
 libraries/process            -           -                               ssh://git@github.com/haskell/process.git
 libraries/terminfo           -           -                               https://github.com/judah/terminfo.git
+libraries/text               -           -                               https://github.com/bos/text.git
 libraries/time               -           -                               https://github.com/haskell/time.git
 libraries/transformers       -           -                               https://git.haskell.org/darcs-mirrors/transformers.git
 libraries/unix               -           -                               ssh://git@github.com/haskell/unix.git
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 43801b8944..cb6a13c897 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -171,7 +171,7 @@ doingRetainerProfiling( void )
 }
 #endif /* PROFILING */
 
-// Precesses a closure 'c' being destroyed whose size is 'size'.
+// Processes a closure 'c' being destroyed whose size is 'size'.
 // Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
 // such as TSO; they should not be involved in computing dragNew or voidNew.
 //
diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 6f1ab79691..f5e96a2c43 100644
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -108,7 +108,7 @@ suspendComputation (Capability *cap, StgTSO *tso, StgUpdateFrame *stop_here)
      yourself using throwTo, the exception would actually immediately
      be delivered.  This is because throwTo itself is considered an
      interruptible point, so the exception is always deliverable. Thus,
-     ordinarily, we never end up with a message to onesself in the
+     ordinarily, we never end up with a message to oneself in the
      blocked_exceptions queue.
    
    - In the case of a StackOverflow, we don't actually care about the
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index 6ca09fc43e..1d5e9230c9 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1755,11 +1755,11 @@ static void
 computeRetainerSet( void )
 {
     StgWeak *weak;
-    RetainerSet *rtl;
     uint32_t g, n;
     StgPtr ml;
     bdescr *bd;
 #if defined(DEBUG_RETAINER)
+    RetainerSet *rtl;
     RetainerSet tmpRetainerSet;
 #endif
 
@@ -1801,9 +1801,9 @@ computeRetainerSet( void )
             for (ml = bd->start; ml < bd->free; ml++) {
 
                 maybeInitRetainerSet((StgClosure *)*ml);
-                rtl = retainerSetOf((StgClosure *)*ml);
 
 #if defined(DEBUG_RETAINER)
+                rtl = retainerSetOf((StgClosure *)*ml);
                 if (rtl == NULL) {
                     // first visit to *ml
                     // This is a violation of the interface rule!
diff --git a/rts/RetainerSet.h b/rts/RetainerSet.h
index 52f12dc155..1b4dec0b3e 100644
--- a/rts/RetainerSet.h
+++ b/rts/RetainerSet.h
@@ -67,7 +67,7 @@ typedef struct _RetainerSet {
   struct _RetainerSet *link;    // link to the next retainer set in the bucket
   int id;   // unique id of this retainer set (used when printing)
             // Its absolute value is interpreted as its true id; if id is
-            // negative, it indicates that this retainer set has had a postive
+            // negative, it indicates that this retainer set has had a positive
             // cost after some retainer profiling.
   retainer element[0];          // elements of this retainer set
   // do not put anything below here!
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 7b10d2a67d..06d59f0550 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -46,12 +46,11 @@ int     rts_argc = 0;  /* ditto */
 char  **rts_argv = NULL;
 int     rts_argv_size = 0;
 #if defined(mingw32_HOST_OS)
-// On Windows, we want to use GetCommandLineW rather than argc/argv,
-// but we need to mutate the command line arguments for withProgName and
-// friends. The System.Environment module achieves that using this bit of
-// shared state:
-int       win32_prog_argc = 0;
-wchar_t **win32_prog_argv = NULL;
+// On Windows hs_main uses GetCommandLineW to get Unicode arguments and
+// passes them along UTF8 encoded as argv. We store them here in order to
+// free them on exit.
+int       win32_full_utf8_argc = 0;
+char**    win32_utf8_argv = NULL;
 #endif
 
 // The global rtsConfig, set from the RtsConfig supplied by the call
@@ -111,6 +110,9 @@ static void read_trace_flags(const char *arg);
 
 static void errorUsage (void) GNU_ATTRIBUTE(__noreturn__);
 
+#if defined(mingw32_HOST_OS)
+static char** win32_full_utf8_argv;
+#endif
 static char *  copyArg (char *arg);
 static char ** copyArgv (int argc, char *argv[]);
 static void    freeArgv (int argc, char *argv[]);
@@ -446,6 +448,66 @@ usage_text[] = {
 0
 };
 
+/**
+Note [Windows Unicode Arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+On Windows argv is usually encoded in the current Codepage which might not
+support unicode.
+
+Instead of ignoring the arguments to hs_init we expect them to be utf-8
+encoded when coming from a custom main function. In the regular hs_main we
+get the unicode arguments from the windows API and pass them along utf8
+encoded instead.
+
+This reduces special casing of arguments in later parts of the RTS and base
+libraries to dealing with slash differences and using utf8 instead of the
+current locale on Windows when decoding arguments.
+
+*/
+
+#if defined(mingw32_HOST_OS)
+//Allocate a buffer and return the string utf8 encoded.
+char* lpcwstrToUTF8(const wchar_t* utf16_str)
+{
+    //Check the utf8 encoded size first
+    int res = WideCharToMultiByte(CP_UTF8, 0, utf16_str, -1, NULL, 0,
+                                  NULL, NULL);
+    if (res == 0) {
+        return NULL;
+    }
+    char* buffer = (char*) stgMallocBytes((size_t)res, "getUTF8Args 2");
+    res = WideCharToMultiByte(CP_UTF8, 0, utf16_str, -1, buffer, res,
+                              NULL, NULL);
+    return buffer;
+}
+
+char** getUTF8Args(int* argc)
+{
+    LPCWSTR cmdLine = GetCommandLineW();
+    LPWSTR* argvw = CommandLineToArgvW(cmdLine, argc);
+
+    // We create two argument arrays, one which is later permutated by the RTS
+    // instead of the main argv.
+    // The other one is used to free the allocted memory later.
+    char** argv = (char**) stgMallocBytes(sizeof(char*) * (*argc + 1),
+                                          "getUTF8Args 1");
+    win32_full_utf8_argv = (char**) stgMallocBytes(sizeof(char*) * (*argc + 1),
+                                                   "getUTF8Args 1");
+
+    for (int i = 0; i < *argc; i++)
+    {
+        argv[i] = lpcwstrToUTF8(argvw[i]);
+    }
+    argv[*argc] = NULL;
+    memcpy(win32_full_utf8_argv, argv, sizeof(char*) * (*argc + 1));
+
+    LocalFree(argvw);
+    win32_utf8_argv = argv;
+    win32_full_utf8_argc = *argc;
+    return argv;
+}
+#endif
+
 STATIC_INLINE bool strequal(const char *a, const char * b)
 {
     return(strcmp(a, b) == 0);
@@ -514,12 +576,8 @@ static void errorRtsOptsDisabled(const char *s)
 
      - rtsConfig   (global) contains the supplied RtsConfig
 
-  On Windows getArgs ignores argv and instead takes the arguments directly
-  from the WinAPI and removes any which would have been parsed by the RTS.
-
-  If the handling of which arguments are passed to the Haskell side changes
-  these changes have to be synchronized with getArgs in base. See #13287 and
-  Note [Ignore hs_init argv] in System.Environment.
+  On Windows argv is assumed to be utf8 encoded for unicode compatibility.
+  See Note [Windows Unicode Arguments]
 
   -------------------------------------------------------------------------- */
 
@@ -557,6 +615,8 @@ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config)
 
     // process arguments from the GHCRTS environment variable next
     // (arguments from the command line override these).
+    // If we ignore all non-builtin rtsOpts we skip these.
+    if(rtsConfig.rts_opts_enabled != RtsOptsIgnoreAll)
     {
         char *ghc_rts = getenv("GHCRTS");
 
@@ -573,33 +633,44 @@ void setupRtsFlags (int *argc, char *argv[], RtsConfig rts_config)
         }
     }
 
-    // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
-    //   argv[0] must be PGM argument -- leave in argv
-    //
-    for (mode = PGM; arg < total_arg; arg++) {
-        // The '--RTS' argument disables all future +RTS ... -RTS processing.
-        if (strequal("--RTS", argv[arg])) {
-            arg++;
-            break;
-        }
-        // The '--' argument is passed through to the program, but
-        // disables all further +RTS ... -RTS processing.
-        else if (strequal("--", argv[arg])) {
-            break;
-        }
-        else if (strequal("+RTS", argv[arg])) {
-            mode = RTS;
-        }
-        else if (strequal("-RTS", argv[arg])) {
-            mode = PGM;
-        }
-        else if (mode == RTS) {
-            appendRtsArg(copyArg(argv[arg]));
-        }
-        else {
-            argv[(*argc)++] = argv[arg];
+
+    // If we ignore all commandline rtsOpts we skip processing of argv by
+    // the RTS completely
+    if(!(rtsConfig.rts_opts_enabled == RtsOptsIgnoreAll ||
+         rtsConfig.rts_opts_enabled == RtsOptsIgnore)
+    )
+    {
+        // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
+        //   argv[0] must be PGM argument -- leave in argv
+        //
+        for (mode = PGM; arg < total_arg; arg++) {
+            // The '--RTS' argument disables all future
+            // +RTS ... -RTS processing.
+            if (strequal("--RTS", argv[arg])) {
+                arg++;
+                break;
+            }
+            // The '--' argument is passed through to the program, but
+            // disables all further +RTS ... -RTS processing.
+            else if (strequal("--", argv[arg])) {
+                break;
+            }
+            else if (strequal("+RTS", argv[arg])) {
+                mode = RTS;
+            }
+            else if (strequal("-RTS", argv[arg])) {
+                mode = PGM;
+            }
+            else if (mode == RTS) {
+                appendRtsArg(copyArg(argv[arg]));
+            }
+            else {
+                argv[(*argc)++] = argv[arg];
+            }
         }
+
     }
+
     // process remaining program arguments
     for (; arg < total_arg; arg++) {
         argv[(*argc)++] = argv[arg];
@@ -2040,48 +2111,18 @@ void freeWin32ProgArgv (void);
 void
 freeWin32ProgArgv (void)
 {
-    int i;
-
-    if (win32_prog_argv != NULL) {
-        for (i = 0; i < win32_prog_argc; i++) {
-            stgFree(win32_prog_argv[i]);
-        }
-        stgFree(win32_prog_argv);
+    if(win32_utf8_argv == NULL) {
+        return;
+    }
+    else
+    {
+        freeArgv(win32_full_utf8_argc, win32_full_utf8_argv);
+        stgFree(win32_utf8_argv);
     }
 
-    win32_prog_argc = 0;
-    win32_prog_argv = NULL;
-}
 
-void
-getWin32ProgArgv(int *argc, wchar_t **argv[])
-{
-    *argc = win32_prog_argc;
-    *argv = win32_prog_argv;
 }
 
-void
-setWin32ProgArgv(int argc, wchar_t *argv[])
-{
-        int i;
-
-        freeWin32ProgArgv();
-
-    win32_prog_argc = argc;
-        if (argv == NULL) {
-                win32_prog_argv = NULL;
-                return;
-        }
-
-    win32_prog_argv = stgCallocBytes(argc + 1, sizeof (wchar_t *),
-                                    "setWin32ProgArgv 1");
-    for (i = 0; i < argc; i++) {
-        win32_prog_argv[i] = stgMallocBytes((wcslen(argv[i]) + 1) * sizeof(wchar_t),
-                                           "setWin32ProgArgv 2");
-        wcscpy(win32_prog_argv[i], argv[i]);
-    }
-    win32_prog_argv[argc] = NULL;
-}
 #endif
 
 /* ----------------------------------------------------------------------------
diff --git a/rts/RtsFlags.h b/rts/RtsFlags.h
index 71ad219d29..c36c64a63b 100644
--- a/rts/RtsFlags.h
+++ b/rts/RtsFlags.h
@@ -13,6 +13,11 @@
 
 /* Routines that operate-on/to-do-with RTS flags: */
 
+#if defined(mingw32_HOST_OS)
+//The returned buffer has to be freed with stgFree()
+char* lpcwstrToUTF8(const wchar_t* utf16_str);
+char** getUTF8Args(int* argc);
+#endif
 void initRtsFlagsDefaults (void);
 void setupRtsFlags        (int *argc, char *argv[], RtsConfig rtsConfig);
 void freeRtsArgs          (void);
diff --git a/rts/RtsMain.c b/rts/RtsMain.c
index d9f05576a0..57c38742b6 100644
--- a/rts/RtsMain.c
+++ b/rts/RtsMain.c
@@ -13,6 +13,7 @@
 #include "RtsAPI.h"
 
 #include "RtsUtils.h"
+#include "RtsFlags.h"
 #include "Prelude.h"
 #include "Task.h"
 #include "Excn.h"
@@ -48,6 +49,16 @@ int hs_main ( int argc, char *argv[],       // program args
     int exit_status;
     SchedulerStatus status;
 
+    // See Note: [Windows Unicode Arguments] in rts/RtsFlags.c
+    #if defined(mingw32_HOST_OS)
+    {
+        argv = getUTF8Args(&argc);
+    }
+    #endif
+
+
+
+
     hs_init_ghc(&argc, &argv, rts_config);
 
     // kick off the computation by creating the main thread with a pointer
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 71a842d0a9..e4ca6b906d 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -179,7 +179,33 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     if (argc == NULL || argv == NULL) {
         // Use a default for argc & argv if either is not supplied
         int my_argc = 1;
+        #if defined(mingw32_HOST_OS)
+        //Retry larger buffer sizes on error up to about the NTFS length limit.
+        wchar_t* pathBuf;
+        char *my_argv[2] = { NULL, NULL };
+        for(DWORD maxLength = MAX_PATH; maxLength <= 33280; maxLength *= 2)
+        {
+            pathBuf = (wchar_t*) stgMallocBytes(sizeof(wchar_t) * maxLength,
+                "hs_init_ghc: GetModuleFileName");
+            DWORD pathLength = GetModuleFileNameW(NULL, pathBuf, maxLength);
+            if(GetLastError() == ERROR_INSUFFICIENT_BUFFER || pathLength == 0) {
+                stgFree(pathBuf);
+                pathBuf = NULL;
+            } else {
+                break;
+            }
+        }
+        if(pathBuf == NULL) {
+            my_argv[0] = "<unknown>";
+        } else {
+            my_argv[0] = lpcwstrToUTF8(pathBuf);
+            stgFree(pathBuf);
+        }
+
+
+        #else
         char *my_argv[] = { "<unknown>", NULL };
+        #endif
         setFullProgArgv(my_argc,my_argv);
         setupRtsFlags(&my_argc, my_argv, rts_config);
     } else {
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 11b1437f77..e80a4955f0 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -97,8 +97,6 @@
       SymI_HasProto(stg_asyncReadzh)                     \
       SymI_HasProto(stg_asyncWritezh)                    \
       SymI_HasProto(stg_asyncDoProczh)                   \
-      SymI_HasProto(getWin32ProgArgv)                    \
-      SymI_HasProto(setWin32ProgArgv)                    \
       SymI_HasProto(rts_InstallConsoleEvent)             \
       SymI_HasProto(rts_ConsoleHandlerDone)              \
       SymI_HasProto(atexit)                              \
diff --git a/rules/sdist-ghc-file.mk b/rules/sdist-ghc-file.mk
index 9ea0b6521a..d6a70e10fb 100644
--- a/rules/sdist-ghc-file.mk
+++ b/rules/sdist-ghc-file.mk
@@ -44,3 +44,34 @@ sdist_$1_$2_$4 : $1/$2/build/$4.hs
 # didn't generate all package-data.mk files.
 $$(eval $$(call hs-suffix-rules-srcdir,$1,$2,$3))
 endef
+
+# -----------------------------------------------------------------------------
+# Variant of sdist-ghc-file whose `$3`-argument is interpreted
+# differently in a more appropriate way for cabal-packages
+
+define sdist-ghc-file2
+# $1 = dir
+# $2 = distdir
+# $3 = moduledir
+# $4 = filename
+# $5 = extension
+
+.PHONY: sdist_$1_$2_$4
+
+# We should do this before creating the `sdist-ghc` tarball, or when just
+# running `make sdist-ghc-prep`.
+sdist-ghc-prep : sdist_$1_$2_$4
+
+# But first create SRC_DIST_GHC_DIR.
+sdist_$1_$2_$4 : sdist-ghc-prep-tree
+
+# Generate the .hs files if they don't exist yet, then do actual copying and
+# moving.
+sdist_$1_$2_$4 : $1/$2/build/$3/$4.hs
+	"$(CP)" $1/$2/build/$3/$4.hs $(SRC_DIST_GHC_DIR)/$1/$3
+	mv $(SRC_DIST_GHC_DIR)/$1/$3/$4.$5 $(SRC_DIST_GHC_DIR)/$1/$3/$4.$5.source
+
+# And make sure the rules for generating the .hs files exist, even when we
+# didn't generate all package-data.mk files.
+$$(eval $$(call hs-suffix-rules-srcdir,$1,$2,$3))
+endef
diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py
new file mode 100644
index 0000000000..01a5f47acc
--- /dev/null
+++ b/testsuite/driver/junit.py
@@ -0,0 +1,38 @@
+from datetime import datetime
+import xml.etree.ElementTree as ET
+
+def junit(t):
+    testsuites = ET.Element('testsuites')
+    testsuite = ET.SubElement(testsuites, 'testsuite',
+                              id = "0",
+                              package = 'ghc',
+                              tests = str(t.total_tests),
+                              failures = str(len(t.unexpected_failures) + len(t.unexpected_stat_failures)),
+                              errors = str(len(t.framework_failures)),
+                              timestamp = datetime.now().isoformat())
+
+    for result, group in [('stat failure', t.unexpected_stat_failures),
+                          ('unexpected failure', t.unexpected_failures)]:
+        for (directory, testname, reason, way) in group:
+            testcase = ET.SubElement(testsuite, 'testcase',
+                                     classname = testname,
+                                     name = way)
+            result = ET.SubElement(testcase, 'failure',
+                                   type = result,
+                                   message = reason)
+
+    for (directory, testname, reason, way) in t.framework_failures:
+        testcase = ET.SubElement(testsuite, 'testcase',
+                                 classname = testname,
+                                 name = way)
+        result = ET.SubElement(testcase, 'error',
+                               type = "framework failure",
+                               message = reason)
+
+    for (directory, testname, way) in t.expected_passes:
+        testcase = ET.SubElement(testsuite, 'testcase',
+                                 classname = testname,
+                                 name = way)
+
+    return ET.ElementTree(testsuites)
+
diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py
index 7e4f375a2c..3e03ed306c 100644
--- a/testsuite/driver/runtests.py
+++ b/testsuite/driver/runtests.py
@@ -6,11 +6,11 @@
 
 from __future__ import print_function
 
+import argparse
 import signal
 import sys
 import os
 import string
-import getopt
 import shutil
 import tempfile
 import time
@@ -26,6 +26,7 @@ import subprocess
 
 from testutil import *
 from testglobals import *
+from junit import junit
 
 # Readline sometimes spews out ANSI escapes for some values of TERM,
 # which result in test failures. Thus set TERM to a nice, simple, safe
@@ -41,81 +42,61 @@ def signal_handler(signal, frame):
 # -----------------------------------------------------------------------------
 # cmd-line options
 
-long_options = [
-  "configfile=",	# config file
-  "config=",  		# config field
-  "rootdir=", 		# root of tree containing tests (default: .)
-  "summary-file=",      # file in which to save the (human-readable) summary
-  "no-print-summary=",  # should we print the summary?
-  "only=",		# just this test (can be give multiple --only= flags)
-  "way=",		# just this way
-  "skipway=",		# skip this way
-  "threads=",           # threads to run simultaneously
-  "check-files-written", # check files aren't written by multiple tests
-  "verbose=",          # verbose (0,1,2 so far)
-  "skip-perf-tests",       # skip performance tests
-  ]
-
-opts, args = getopt.getopt(sys.argv[1:], "e:", long_options)
-       
-for opt,arg in opts:
-    if opt == '--configfile':
-        exec(open(arg).read())
-
-    # -e is a string to execute from the command line.  For example:
-    # testframe -e 'config.compiler=ghc-5.04'
-    if opt == '-e':
-        exec(arg)
-
-    if opt == '--config':
-        field, value = arg.split('=', 1)
-        setattr(config, field, value)
-
-    if opt == '--rootdir':
-        config.rootdirs.append(arg)
-
-    if opt == '--summary-file':
-        config.summary_file = arg
-
-    if opt == '--no-print-summary':
-        config.no_print_summary = True
-
-    if opt == '--only':
-        config.run_only_some_tests = True
-        config.only.add(arg)
-
-    if opt == '--way':
-        if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways):
-            sys.stderr.write("ERROR: requested way \'" +
-                             arg + "\' does not exist\n")
-            sys.exit(1)
-        config.cmdline_ways = [arg] + config.cmdline_ways
-        if (arg in config.other_ways):
-            config.run_ways = [arg] + config.run_ways
-            config.compile_ways = [arg] + config.compile_ways
-
-    if opt == '--skipway':
-        if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways):
-            sys.stderr.write("ERROR: requested way \'" +
-                             arg + "\' does not exist\n")
-            sys.exit(1)
-        config.other_ways = [w for w in config.other_ways if w != arg]
-        config.run_ways = [w for w in config.run_ways if w != arg]
-        config.compile_ways = [w for w in config.compile_ways if w != arg]
-
-    if opt == '--threads':
-        config.threads = int(arg)
-        config.use_threads = 1
-
-    if opt == '--skip-perf-tests':
-        config.skip_perf_tests = True
-
-    if opt == '--verbose':
-        if arg not in ["0","1","2","3","4","5"]:
-            sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2,3,4 or 5" % arg)
-            sys.exit(1)
-        config.verbose = int(arg)
-
+parser = argparse.ArgumentParser(description="GHC's testsuite driver")
+
+parser.add_argument("-e", action='append', help="A string to execute from the command line.")
+parser.add_argument("--config-file", action="append", help="config file")
+parser.add_argument("--config", action='append', help="config field")
+parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)")
+parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary")
+parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?")
+parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)")
+parser.add_argument("--way", choices=config.run_ways+config.compile_ways+config.other_ways, help="just this way")
+parser.add_argument("--skipway", action="append", choices=config.run_ways+config.compile_ways+config.other_ways, help="skip this way")
+parser.add_argument("--threads", type=int, help="threads to run simultaneously")
+parser.add_argument("--check-files-written", help="check files aren't written by multiple tests") # NOTE: This doesn't seem to exist?
+parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose (Values 0 through 5 accepted)")
+parser.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests")
+parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format")
+
+args = parser.parse_args()
+
+for e in args.e:
+    exec(e)
+
+for arg in args.config_file:
+    exec(open(arg).read())
+
+for arg in args.config:
+    field, value = arg.split('=', 1)
+    setattr(config, field, value)
+
+config.rootdirs = args.rootdir
+config.summary_file = args.summary_file
+config.no_print_summary = args.no_print_summary
+
+if args.only:
+    config.only = args.only
+    config.run_only_some_tests = True
+
+if args.way:
+    config.cmdline_ways = [args.way] + config.cmdline_ways
+    if (args.way in config.other_ways):
+        config.run_ways = [args.way] + config.run_ways
+        config.compile_ways = [args.way] + config.compile_ways
+
+if args.skipway:
+    config.other_ways = [w for w in config.other_ways if w != args.skipway]
+    config.run_ways = [w for w in config.run_ways if w != args.skipway]
+    config.compile_ways = [w for w in config.compile_ways if w != args.skipway]
+
+if args.threads:
+    config.threads = args.threads
+    config.use_threads = True
+
+if args.verbose:
+    config.verbose = args.verbose
+config.skip_perf_tests = args.skip_perf_tests
 
 config.cygwin = False
 config.msys = False
@@ -326,10 +307,13 @@ else:
 
     summary(t, sys.stdout, config.no_print_summary)
 
-    if config.summary_file != '':
+    if config.summary_file:
         with open(config.summary_file, 'w') as file:
             summary(t, file)
 
+    if args.junit:
+        junit(t).write(args.junit)
+
 cleanup_and_exit(0)
 
 # Note [Running tests in /tmp]
diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py
index fc050e6908..5e7142d9c8 100644
--- a/testsuite/driver/testglobals.py
+++ b/testsuite/driver/testglobals.py
@@ -140,6 +140,7 @@ class TestRun:
        self.framework_failures = []
        self.framework_warnings = []
 
+       self.expected_passes = []
        self.unexpected_passes = []
        self.unexpected_failures = []
        self.unexpected_stat_failures = []
diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py
index 26e3d17679..15c773e3f7 100644
--- a/testsuite/driver/testlib.py
+++ b/testsuite/driver/testlib.py
@@ -863,6 +863,7 @@ def do_test(name, way, func, args, files):
 
     if passFail == 'pass':
         if _expect_pass(way):
+            t.expected_passes.append((directory, name, way))
             t.n_expected_passes += 1
         else:
             if_verbose(1, '*** unexpected pass for %s' % full_name)
diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk
index a44e200d49..a21c4bb16b 100644
--- a/testsuite/mk/test.mk
+++ b/testsuite/mk/test.mk
@@ -73,7 +73,7 @@ else
 dllext = .so
 endif
 
-RUNTEST_OPTS += -e ghc_compiler_always_flags="'$(TEST_HC_OPTS)'"
+RUNTEST_OPTS += -e "ghc_compiler_always_flags='$(TEST_HC_OPTS)'"
 
 RUNTEST_OPTS += -e config.compiler_debugged=$(GhcDebugged)
 
@@ -214,7 +214,7 @@ endif
 
 RUNTEST_OPTS +=  \
 	--rootdir=. \
-	--configfile=$(CONFIG) \
+	--config-file=$(CONFIG) \
 	-e 'config.confdir="$(CONFIGDIR)"' \
 	-e 'config.platform="$(TARGETPLATFORM)"' \
 	-e 'config.os="$(TargetOS_CPP)"' \
@@ -246,13 +246,17 @@ RUNTEST_OPTS +=  \
 
 RUNTEST_OPTS += -e "config.stage=$(GhcStage)"
 
+ifneq "$(JUNIT_FILE)" ""
+RUNTEST_OPTS +=  \
+  --junit "$(JUNIT_FILE)"
+endif
 ifneq "$(SUMMARY_FILE)" ""
 RUNTEST_OPTS +=  \
 	--summary-file "$(SUMMARY_FILE)"
 endif
 ifeq "$(NO_PRINT_SUMMARY)" "YES"
 RUNTEST_OPTS +=  \
-	--no-print-summary 1
+	--no-print-summary
 endif
 
 RUNTEST_OPTS +=  \
diff --git a/testsuite/tests/dependent/should_compile/T12176.hs b/testsuite/tests/dependent/should_compile/T12176.hs
new file mode 100644
index 0000000000..0e340068a7
--- /dev/null
+++ b/testsuite/tests/dependent/should_compile/T12176.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE RankNTypes, TypeInType, GADTs, TypeFamilies #-}
+
+module T12176 where
+
+import Data.Kind
+
+data Proxy :: forall k. k -> Type where
+  MkProxy :: forall k (a :: k). Proxy a
+
+data X where
+  MkX :: forall (k :: Type) (a :: k). Proxy a -> X
+
+type Expr = (MkX :: forall (a :: Bool). Proxy a -> X)
+
+type family Foo (x :: forall (a :: k). Proxy a -> X) where
+  Foo (MkX :: forall (a :: k). Proxy a -> X) = (MkProxy :: Proxy k)
+
+type Bug = Foo Expr  -- this failed with #12176
diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T
index 8a9b221a4e..b854f1d9e7 100644
--- a/testsuite/tests/dependent/should_compile/all.T
+++ b/testsuite/tests/dependent/should_compile/all.T
@@ -24,3 +24,4 @@ test('T11719', normal, compile, [''])
 test('T11966', normal, compile, [''])
 test('T12442', normal, compile, [''])
 test('T13538', normal, compile, [''])
+test('T12176', normal, compile, [''])
diff --git a/testsuite/tests/dependent/should_fail/T11471.hs b/testsuite/tests/dependent/should_fail/T11471.hs
index 19025db22b..ae09ae07bb 100644
--- a/testsuite/tests/dependent/should_fail/T11471.hs
+++ b/testsuite/tests/dependent/should_fail/T11471.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies #-}
+{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies, AllowAmbiguousTypes #-}
 
 module T11471 where
 
diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr
index 80c5fc606c..640ae6c754 100644
--- a/testsuite/tests/dependent/should_fail/T11471.stderr
+++ b/testsuite/tests/dependent/should_fail/T11471.stderr
@@ -1,19 +1,22 @@
 
 T11471.hs:15:10: error:
     • Couldn't match a lifted type with an unlifted type
-      Expected type: Proxy Int#
+      When matching types
+        a :: *
+        Int# :: TYPE 'IntRep
+      Expected type: Proxy a
         Actual type: Proxy Int#
-      Use -fprint-explicit-kinds to see the kind arguments
     • In the first argument of ‘f’, namely ‘(undefined :: Proxy Int#)’
       In the expression: f (undefined :: Proxy Int#) 3#
       In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3#
+    • Relevant bindings include bad :: F a (bound at T11471.hs:15:1)
 
 T11471.hs:15:35: error:
     • Couldn't match a lifted type with an unlifted type
       When matching types
-        F Int# :: *
+        F a :: *
         Int# :: TYPE 'IntRep
     • In the second argument of ‘f’, namely ‘3#’
       In the expression: f (undefined :: Proxy Int#) 3#
       In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3#
-    • Relevant bindings include bad :: F Int# (bound at T11471.hs:15:1)
+    • Relevant bindings include bad :: F a (bound at T11471.hs:15:1)
diff --git a/testsuite/tests/dependent/should_fail/T13135.hs b/testsuite/tests/dependent/should_fail/T13135.hs
index c39b3f5842..772ac78bfa 100644
--- a/testsuite/tests/dependent/should_fail/T13135.hs
+++ b/testsuite/tests/dependent/should_fail/T13135.hs
@@ -62,7 +62,7 @@ arrLen = smartSym sym where
 
 
 
-{- The original bug was a familure to subsitute
+{- The original bug was a failure to substitute
    properly during type-function improvement.
 
 --------------------------------------
diff --git a/testsuite/tests/dependent/should_fail/T13601.hs b/testsuite/tests/dependent/should_fail/T13601.hs
new file mode 100644
index 0000000000..5e98c7a657
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13601.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE TypeFamilies, DataKinds, TypeInType #-}
+
+import GHC.Exts
+import Prelude (Bool(True,False),Integer,Ordering,undefined)
+import qualified Prelude
+import Data.Kind
+
+--------------------
+-- class hierarchy
+
+type family
+  Rep (rep :: RuntimeRep) :: RuntimeRep where
+  -- Rep IntRep         = IntRep
+  -- Rep DoubleRep      = IntRep
+  -- Rep PtrRepUnlifted = IntRep
+  -- Rep PtrRepLifted   = PtrRepLifted
+
+class Boolean (Logic a) => Eq (a :: TYPE rep) where
+  type Logic (a :: TYPE rep) :: TYPE (Rep rep)
+  (==) :: a -> a -> Logic a
+
+class Eq a => POrd (a :: TYPE rep) where
+  inf :: a -> a -> a
+
+class POrd a => MinBound (a :: TYPE rep) where
+  minBound :: () -> a
+
+class POrd a => Lattice (a :: TYPE rep) where
+  sup :: a -> a -> a
+
+class (Lattice a, MinBound a) => Bounded (a :: TYPE rep) where
+  maxBound :: () -> a
+
+class Bounded a => Complemented (a :: TYPE rep) where
+  not :: a -> a
+
+class Bounded a => Heyting (a :: TYPE rep) where
+  infixr 3 ==>
+  (==>) :: a -> a -> a
+
+class (Complemented a, Heyting a) => Boolean a
+
+(||) :: Boolean a => a -> a -> a
+(||) = sup
+
+(&&) :: Boolean a => a -> a -> a
+(&&) = inf
diff --git a/testsuite/tests/dependent/should_fail/T13601.stderr b/testsuite/tests/dependent/should_fail/T13601.stderr
new file mode 100644
index 0000000000..c1c9803e5a
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13601.stderr
@@ -0,0 +1,6 @@
+
+T13601.hs:18:16: error:
+    • Expected kind ‘TYPE (Rep 'LiftedRep)’,
+        but ‘Logic a’ has kind ‘TYPE (Rep rep)’
+    • In the first argument of ‘Boolean’, namely ‘(Logic a)’
+      In the class declaration for ‘Eq’
diff --git a/testsuite/tests/dependent/should_fail/T13780a.hs b/testsuite/tests/dependent/should_fail/T13780a.hs
new file mode 100644
index 0000000000..1f7c95c40a
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13780a.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+module T13780a where
+
+data family Sing (a :: k)
+
+data Foo a = a ~ Bool => MkFoo
+data instance Sing (z :: Foo a) = (z ~ MkFoo) => SMkFoo
diff --git a/testsuite/tests/dependent/should_fail/T13780a.stderr b/testsuite/tests/dependent/should_fail/T13780a.stderr
new file mode 100644
index 0000000000..3b113bd89e
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13780a.stderr
@@ -0,0 +1,6 @@
+
+T13780a.hs:9:40: error:
+    • Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’
+    • In the second argument of ‘(~)’, namely ‘MkFoo’
+      In the definition of data constructor ‘SMkFoo’
+      In the data instance declaration for ‘Sing’
diff --git a/testsuite/tests/dependent/should_fail/T13780b.hs b/testsuite/tests/dependent/should_fail/T13780b.hs
new file mode 100644
index 0000000000..238e7a1af9
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13780b.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+module T13780b where
+
+data family Sing (a :: k)
+
+data instance Sing (z :: Bool) =
+    z ~ False => SFalse
+  | z ~ True  => STrue
diff --git a/testsuite/tests/dependent/should_fail/T13780c.hs b/testsuite/tests/dependent/should_fail/T13780c.hs
new file mode 100644
index 0000000000..eee6436237
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13780c.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+module T13780c where
+
+import Data.Kind
+import T13780b
+
+type family ElimBool (p :: Bool -> Type) (b :: Bool) (s :: Sing b)
+                     (pFalse :: p False) (pTrue :: p True) :: p b where
+  ElimBool _ _ SFalse pFalse _ = pFalse
+  ElimBool _ _ STrue  _ pTrue  = pTrue
diff --git a/testsuite/tests/dependent/should_fail/T13780c.stderr b/testsuite/tests/dependent/should_fail/T13780c.stderr
new file mode 100644
index 0000000000..f91d7a3236
--- /dev/null
+++ b/testsuite/tests/dependent/should_fail/T13780c.stderr
@@ -0,0 +1,12 @@
+[1 of 2] Compiling T13780b          ( T13780b.hs, T13780b.o )
+[2 of 2] Compiling T13780c          ( T13780c.hs, T13780c.o )
+
+T13780c.hs:11:16: error:
+    • Expected kind ‘Sing _’, but ‘SFalse’ has kind ‘Sing 'False’
+    • In the third argument of ‘ElimBool’, namely ‘SFalse’
+      In the type family declaration for ‘ElimBool’
+
+T13780c.hs:12:16: error:
+    • Expected kind ‘Sing _1’, but ‘STrue’ has kind ‘Sing 'True’
+    • In the third argument of ‘ElimBool’, namely ‘STrue’
+      In the type family declaration for ‘ElimBool’
diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T
index c648f9ed1d..4eb426419d 100644
--- a/testsuite/tests/dependent/should_fail/all.T
+++ b/testsuite/tests/dependent/should_fail/all.T
@@ -1,5 +1,5 @@
 test('DepFail1', normal, compile_fail, [''])
-test('RAE_T32a', normal, compile_fail, [''])
+test('RAE_T32a', expect_broken(12919), compile_fail, [''])
 test('TypeSkolEscape', normal, compile_fail, [''])
 test('BadTelescope', normal, compile_fail, [''])
 test('BadTelescope2', normal, compile_fail, [''])
@@ -17,3 +17,7 @@ test('T11471', normal, compile_fail, [''])
 test('T12174', normal, compile_fail, [''])
 test('T12081', normal, compile_fail, [''])
 test('T13135', normal, compile_fail, [''])
+test('T13601', normal, compile_fail, [''])
+test('T13780a', normal, compile_fail, [''])
+test('T13780c', [extra_files(['T13780b.hs'])],
+                multimod_compile_fail, ['T13780c', ''])
diff --git a/testsuite/tests/deriving/should_compile/T13998.hs b/testsuite/tests/deriving/should_compile/T13998.hs
new file mode 100644
index 0000000000..565d4a35f7
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13998.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE GADTs #-}
+
+module T13998 where
+
+import Data.Type.Equality
+
+class EqForall f where
+  eqForall :: f a -> f a -> Bool
+
+class EqForall f => EqForallPoly f where
+  eqForallPoly :: f a -> f b -> Bool
+  default eqForallPoly :: TestEquality f => f a -> f b -> Bool
+  eqForallPoly = defaultEqForallPoly
+
+defaultEqForallPoly :: (TestEquality f, EqForall f) => f a -> f b -> Bool
+defaultEqForallPoly x y = case testEquality x y of
+  Nothing -> False
+  Just Refl -> eqForall x y
+
+
+data Atom = AtomInt | AtomString | AtomBool
+
+data Value (a :: Atom) where
+  ValueInt :: Int -> Value 'AtomInt
+  ValueString :: String -> Value 'AtomString
+  ValueBool :: Bool -> Value 'AtomBool
+
+instance TestEquality Value where
+  testEquality (ValueInt _) (ValueInt _) = Just Refl
+  testEquality (ValueString _) (ValueString _) = Just Refl
+  testEquality (ValueBool _) (ValueBool _) = Just Refl
+  testEquality _ _ = Nothing
+
+instance EqForall Value where
+  eqForall (ValueInt a) (ValueInt b) = a == b
+  eqForall (ValueString a) (ValueString b) = a == b
+  eqForall (ValueBool a) (ValueBool b) = a == b
+
+instance EqForallPoly Value
diff --git a/testsuite/tests/deriving/should_compile/T14045b.hs b/testsuite/tests/deriving/should_compile/T14045b.hs
new file mode 100644
index 0000000000..cb18e36029
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14045b.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-}
+
+module T14045b where
+
+import Data.Kind ( Type )
+
+data family T a b :: Type
+
+-- newtype instance T Int d = MkT (IO d)
+
+newtype instance T Int :: Type -> Type where
+   MkT :: IO d -> T Int d
+  deriving( Monad, Applicative, Functor )
diff --git a/testsuite/tests/deriving/should_compile/T14094.hs b/testsuite/tests/deriving/should_compile/T14094.hs
new file mode 100644
index 0000000000..29fa693e97
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14094.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wall #-}
+module Bug where
+
+class C a where
+  type T a
+  data D a
+  m :: a
+
+instance C Int
+deriving instance C Bool
diff --git a/testsuite/tests/deriving/should_compile/T14094.stderr b/testsuite/tests/deriving/should_compile/T14094.stderr
new file mode 100644
index 0000000000..b323a775f5
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T14094.stderr
@@ -0,0 +1,26 @@
+
+T14094.hs:12:1: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit associated type or default declaration for ‘T’
+    • In the instance declaration for ‘C Int’
+
+T14094.hs:12:1: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit associated type or default declaration for ‘D’
+    • In the instance declaration for ‘C Int’
+
+T14094.hs:12:10: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit implementation for
+        ‘m’
+    • In the instance declaration for ‘C Int’
+
+T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit associated type or default declaration for ‘T’
+    • In the instance declaration for ‘C Bool’
+
+T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit associated type or default declaration for ‘D’
+    • In the instance declaration for ‘C Bool’
+
+T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)]
+    • No explicit implementation for
+        ‘m’
+    • In the instance declaration for ‘C Bool’
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 7c7b29070b..65c6d7284e 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -93,3 +93,6 @@ test('drv-empty-data', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddu
 test('drv-phantom', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump-deriv -dsuppress-uniques'])
 test('T13813', normal, compile, [''])
 test('T13919', normal, compile, [''])
+test('T13998', normal, compile, [''])
+test('T14045b', normal, compile, [''])
+test('T14094', normal, compile, [''])
diff --git a/testsuite/tests/deriving/should_fail/T10598_fail3.stderr b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr
index a987a4993d..c3f4e123b7 100644
--- a/testsuite/tests/deriving/should_fail/T10598_fail3.stderr
+++ b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr
@@ -1,5 +1,4 @@
 
-T10598_fail3.hs:1:1: error:
-    Generic instances can only be derived in Safe Haskell using the stock strategy.
-    In the following instance:
-      instance [safe] Generic T
+T10598_fail3.hs:8:36: error:
+    • Generic instances can only be derived in Safe Haskell using the stock strategy.
+    • In the instance declaration for ‘Generic T’
diff --git a/testsuite/tests/deriving/should_fail/T8165_fail2.stderr b/testsuite/tests/deriving/should_fail/T8165_fail2.stderr
index 4c925f52a3..5e19173a33 100644
--- a/testsuite/tests/deriving/should_fail/T8165_fail2.stderr
+++ b/testsuite/tests/deriving/should_fail/T8165_fail2.stderr
@@ -1,5 +1,6 @@
 
 T8165_fail2.hs:9:12: error:
-    The type family application ‘T Loop’
-      is no smaller than the instance head
-    (Use UndecidableInstances to permit this)
+    • The type family application ‘T Loop’
+        is no smaller than the instance head
+      (Use UndecidableInstances to permit this)
+    • In the instance declaration for ‘C Loop’
diff --git a/testsuite/tests/deriving/should_run/T3087.hs b/testsuite/tests/deriving/should_run/T3087.hs
index 9d3be0744d..1e20b9ece9 100644
--- a/testsuite/tests/deriving/should_run/T3087.hs
+++ b/testsuite/tests/deriving/should_run/T3087.hs
@@ -14,7 +14,7 @@ test1' = undefined `ext1Q` (\ (MyJust _) -> ()) $ MyJust ()
 
 newtype Q r a = Q { unQ :: a -> r }
 
-ext2Q :: (Data d, Typeable2 t)
+ext2Q :: (Data d, Typeable t)
       => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
       -> d -> q
 ext2Q def ext arg =
diff --git a/testsuite/tests/driver/T13710/A.hs b/testsuite/tests/driver/T13710/A.hs
new file mode 100644
index 0000000000..5181945eeb
--- /dev/null
+++ b/testsuite/tests/driver/T13710/A.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+module A where
+import B
+data E = MkE
+p (H{..}) = ()
diff --git a/testsuite/tests/driver/T13710/A.hs-boot b/testsuite/tests/driver/T13710/A.hs-boot
new file mode 100644
index 0000000000..94a2f5e306
--- /dev/null
+++ b/testsuite/tests/driver/T13710/A.hs-boot
@@ -0,0 +1,2 @@
+module A ( E ) where
+data E
diff --git a/testsuite/tests/driver/T13710/B.hs b/testsuite/tests/driver/T13710/B.hs
new file mode 100644
index 0000000000..87c93a9f39
--- /dev/null
+++ b/testsuite/tests/driver/T13710/B.hs
@@ -0,0 +1,3 @@
+module B where
+import {-# SOURCE #-} A
+data H = H { h :: E }
diff --git a/testsuite/tests/driver/T13710/Makefile b/testsuite/tests/driver/T13710/Makefile
new file mode 100644
index 0000000000..d582f94af5
--- /dev/null
+++ b/testsuite/tests/driver/T13710/Makefile
@@ -0,0 +1,6 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T13710:
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make B.hs
diff --git a/testsuite/tests/driver/T13710/T13710.stdout b/testsuite/tests/driver/T13710/T13710.stdout
new file mode 100644
index 0000000000..2d729289db
--- /dev/null
+++ b/testsuite/tests/driver/T13710/T13710.stdout
@@ -0,0 +1,3 @@
+[1 of 3] Compiling A[boot]          ( A.hs-boot, A.o-boot )
+[2 of 3] Compiling B                ( B.hs, B.o )
+[3 of 3] Compiling A                ( A.hs, A.o )
diff --git a/testsuite/tests/driver/T13710/all.T b/testsuite/tests/driver/T13710/all.T
new file mode 100644
index 0000000000..64daacc96b
--- /dev/null
+++ b/testsuite/tests/driver/T13710/all.T
@@ -0,0 +1,4 @@
+test('T13710',
+     [extra_files(['A.hs', 'A.hs-boot', 'B.hs'])],
+     run_command,
+     ['$MAKE -s --no-print-directory T13710'])
diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr
index ea9033ac6c..bb179975fb 100644
--- a/testsuite/tests/gadt/gadt7.stderr
+++ b/testsuite/tests/gadt/gadt7.stderr
@@ -1,15 +1,15 @@
 
 gadt7.hs:16:38: error:
     • Couldn't match expected type ‘p1’ with actual type ‘p’
-        ‘p1’ is untouchable
+        ‘p’ is untouchable
           inside the constraints: a ~ Int
           bound by a pattern with constructor: K :: T Int,
                    in a case alternative
           at gadt7.hs:16:33
-      ‘p1’ is a rigid type variable bound by
-        the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44
       ‘p’ is a rigid type variable bound by
         the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44
+      ‘p1’ is a rigid type variable bound by
+        the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44
       Possible fix: add a type signature for ‘i1b’
     • In the expression: y1
       In a case alternative: K -> y1
diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs
index fc0a71ade3..f1a619be1a 100644
--- a/testsuite/tests/ghc-api/T6145.hs
+++ b/testsuite/tests/ghc-api/T6145.hs
@@ -34,8 +34,6 @@ main = do
     where
       isDataCon (L _ (AbsBinds { abs_binds = bs }))
         = not (isEmptyBag (filterBag isDataCon bs))
-      isDataCon (L _ (AbsBindsSig { abs_sig_bind = b }))
-        = isDataCon b
       isDataCon (L l (f@FunBind {}))
         | (MG (L _ (m:_)) _ _ _) <- fun_matches f,
           (L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 96de3a334b..9e533aa192 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -50,8 +50,7 @@ test('break009', [extra_files(['../Test6.hs']),
 test('break010', extra_files(['../Test6.hs']), ghci_script, ['break010.script'])
 test('break011',
      [extra_files(['../Test7.hs']),
-      combined_output,
-      when(msys(), expect_broken(12712))],
+      combined_output],
      ghci_script, ['break011.script'])
 test('break012', normal, ghci_script, ['break012.script'])
 test('break013', normal, ghci_script, ['break013.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout
index 2e86b42713..5d478ae04e 100644
--- a/testsuite/tests/ghci.debugger/scripts/break012.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout
@@ -1,14 +1,14 @@
 Stopped in Main.g, break012.hs:5:10-18
-_result :: (p, a1 -> a1, (), a -> a -> a) = _
-a :: p = _
-b :: a2 -> a2 = _
+_result :: (a1, a2 -> a2, (), a -> a -> a) = _
+a :: a1 = _
+b :: a3 -> a3 = _
 c :: () = _
 d :: a -> a -> a = _
-a :: p
-b :: a2 -> a2
+a :: a1
+b :: a3 -> a3
 c :: ()
 d :: a -> a -> a
-a = (_t1::p)
-b = (_t2::a2 -> a2)
+a = (_t1::a1)
+b = (_t2::a3 -> a3)
 c = (_t3::())
 d = (_t4::a -> a -> a)
diff --git a/testsuite/tests/indexed-types/should_compile/T12369.hs b/testsuite/tests/indexed-types/should_compile/T12369.hs
new file mode 100644
index 0000000000..51cee7df03
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T12369.hs
@@ -0,0 +1,35 @@
+{-# language PolyKinds, KindSignatures, GADTs, TypeFamilies, RankNTypes, TypeInType,
+             TypeOperators, ConstraintKinds #-}
+
+module T12369 where
+
+import Data.Kind
+
+data family Fix :: (k -> *) -> k
+newtype instance Fix f = In { out :: f (Fix f) }
+
+type FREE k = (k -> Constraint) -> (k -> k)
+type f  ~> g = forall a. f a -> g a
+type f ~~> g = forall a b. f a b -> g a b
+
+data    family   Free k :: FREE k
+
+newtype instance Free Type k p where
+  Free0 :: (forall q. k q => (p  -> q) -> q) -> Free Type k p
+
+newtype instance Free (j -> Type) k p a where
+  Free1 :: (forall q. k q => (p  ~> q) -> q a) -> Free (j -> Type) k p a
+
+newtype instance Free (j1 -> j2 -> Type) k p a b where
+  Free2 :: (forall q. k q => (p ~~> q) -> q a b) -> Free (j1 -> j2 -> Type) k p a b
+
+data family Free2 :: FREE k
+
+newtype instance Free2 :: FREE Type where
+  Free20 :: (forall q. k q => (p  -> q) -> q) -> Free2 k p
+
+newtype instance Free2 :: forall k. FREE (k -> Type) where
+  Free21 :: (forall q. k q => (p  ~> q) -> q a) -> Free2 k p a
+
+newtype instance Free2 :: forall k1 k2. FREE (k1 -> k2 -> Type) where
+  Free22 :: (forall q. k q => (p ~~> q) -> q a b) -> Free2 k p a b
diff --git a/testsuite/tests/indexed-types/should_compile/T14045.hs b/testsuite/tests/indexed-types/should_compile/T14045.hs
new file mode 100644
index 0000000000..951388bfce
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T14045.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-}
+
+module T14045 where
+
+import Data.Kind
+
+data family Sing (a :: k)
+data instance Sing :: Bool -> Type where
+  SFalse :: Sing False
+  STrue  :: Sing True
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index ec55113e6b..359e7d5794 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -265,3 +265,5 @@ test('T13398a', normal, compile, [''])
 test('T13398b', normal, compile, [''])
 test('T13662', normal, compile, [''])
 test('T13705', normal, compile, [''])
+test('T12369', normal, compile, [''])
+test('T14045', normal, compile, [''])
diff --git a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
index 937a18d861..53dc8b4ac0 100644
--- a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
+++ b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr
@@ -1,6 +1,4 @@
 
-Overlap4.hs:7:12: error:
-    • Expecting one more argument to ‘Maybe’
-      Expected a type, but ‘Maybe’ has kind ‘* -> *’
-    • In the type ‘Maybe’
-      In the type family declaration for ‘F’
+Overlap4.hs:7:3: error:
+    • Number of parameters must match family declaration; expected 2
+    • In the type family declaration for ‘F’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
index b0c91af91a..8637eaa892 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr
@@ -1,4 +1,5 @@
 
 SimpleFail1a.hs:4:1: error:
-    • Number of parameters must match family declaration; expected 2
+    • Expecting one more argument to ‘T1 Int’
+      Expected a type, but ‘T1 Int’ has kind ‘* -> *’
     • In the data instance declaration for ‘T1’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
index e872f115a2..32303ecccb 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr
@@ -1,6 +1,4 @@
 
-SimpleFail1b.hs:4:1:
-    Too many parameters to T1:
-      Char is unexpected;
-      expected only two parameters
-    In the data instance declaration for ‘T1’
+SimpleFail1b.hs:4:1: error:
+    • Expected kind ‘* -> *’, but ‘T1 Int Bool’ has kind ‘*’
+    • In the data instance declaration for ‘T1’
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
index a9262eb9ec..9bd571e2b9 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr
@@ -2,6 +2,6 @@
 SimpleFail2a.hs:11:3: error:
     • Type indexes must match class instance head
       Expected: Sd Int
-      Actual:   Sd a
+        Actual: Sd a :: *
     • In the data instance declaration for ‘Sd’
       In the instance declaration for ‘C Int’
diff --git a/testsuite/tests/indexed-types/should_fail/T12867.stderr b/testsuite/tests/indexed-types/should_fail/T12867.stderr
index 40e566b3ec..2115e43541 100644
--- a/testsuite/tests/indexed-types/should_fail/T12867.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T12867.stderr
@@ -1,7 +1,6 @@
 
 T12867.hs:7:21: error:
-    • Expecting one fewer arguments to ‘TestM’
-      Expected kind ‘k0 -> *’, but ‘TestM’ has kind ‘*’
+    • Expected kind ‘k0 -> *’, but ‘TestM’ has kind ‘*’
     • In the first argument of ‘Eq’, namely ‘(TestM a)’
       In the type ‘(Eq (TestM a))’
       In the type declaration for ‘Test2’
diff --git a/testsuite/tests/indexed-types/should_fail/T13877.hs b/testsuite/tests/indexed-types/should_fail/T13877.hs
new file mode 100644
index 0000000000..ee5f16b1f3
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13877.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+module T13877 where
+
+import Data.Kind
+
+data family Sing (a :: k)
+data instance Sing (z :: [a]) where
+  SNil  :: Sing '[]
+  SCons :: Sing x -> Sing xs -> Sing (x:xs)
+
+data TyFun :: * -> * -> *
+type a ~> b = TyFun a b -> *
+infixr 0 ~>
+
+type family Apply (f :: k1 ~> k2) (x :: k1) :: k2
+type a @@ b = Apply a b
+infixl 9 @@
+
+data FunArrow = (:->) | (:~>)
+
+class FunType (arr :: FunArrow) where
+  type Fun (k1 :: Type) arr (k2 :: Type) :: Type
+
+class FunType arr => AppType (arr :: FunArrow) where
+  type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2
+
+type FunApp arr = (FunType arr, AppType arr)
+
+instance FunType (:->) where
+  type Fun k1 (:->) k2 = k1 -> k2
+
+instance AppType (:->) where
+  type App k1 (:->) k2 (f :: k1 -> k2) x = f x
+
+instance FunType (:~>) where
+  type Fun k1 (:~>) k2 = k1 ~> k2
+
+instance AppType (:~>) where
+  type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x
+
+infixr 0 -?>
+type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2
+
+listElim :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]).
+            Sing l
+         -> p '[]
+         -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs))
+         -> p l
+listElim = listElimPoly @(:->) @a @p @l
+
+listElimTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]).
+                 Sing l
+              -> p @@ '[]
+              -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs))
+              -> p @@ l
+listElimTyFun = listElimPoly @(:->) @a @p @l
+
+listElimPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]).
+                FunApp arr
+             => Sing l
+             -> App [a] arr Type p '[]
+             -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs))
+             -> App [a] arr Type p l
+listElimPoly SNil                      pNil _     = pNil
+listElimPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (listElimPoly @arr @a @p @xs xs pNil pCons)
diff --git a/testsuite/tests/indexed-types/should_fail/T13877.stderr b/testsuite/tests/indexed-types/should_fail/T13877.stderr
new file mode 100644
index 0000000000..4498d97a41
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T13877.stderr
@@ -0,0 +1,31 @@
+
+T13877.hs:65:17: error:
+    • Couldn't match type ‘p xs’ with ‘Apply p xs’
+      Expected type: Sing x
+                     -> Sing xs -> App [a] (':->) * p xs -> App [a] (':->) * p (x : xs)
+        Actual type: Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs)
+    • In the expression: listElimPoly @(:->) @a @p @l
+      In an equation for ‘listElimTyFun’:
+          listElimTyFun = listElimPoly @(:->) @a @p @l
+    • Relevant bindings include
+        listElimTyFun :: Sing l
+                         -> (p @@ '[])
+                         -> (forall (x :: a) (xs :: [a]).
+                             Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs))
+                         -> p @@ l
+          (bound at T13877.hs:65:1)
+
+T13877.hs:65:41: error:
+    • Expecting one more argument to ‘p’
+      Expected kind ‘(-?>) [a] * (':->)’, but ‘p’ has kind ‘[a] ~> *’
+    • In the type ‘p’
+      In the expression: listElimPoly @(:->) @a @p @l
+      In an equation for ‘listElimTyFun’:
+          listElimTyFun = listElimPoly @(:->) @a @p @l
+    • Relevant bindings include
+        listElimTyFun :: Sing l
+                         -> (p @@ '[])
+                         -> (forall (x :: a) (xs :: [a]).
+                             Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs))
+                         -> p @@ l
+          (bound at T13877.hs:65:1)
diff --git a/testsuite/tests/indexed-types/should_fail/T14033.hs b/testsuite/tests/indexed-types/should_fail/T14033.hs
new file mode 100644
index 0000000000..2c8ab68a05
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T14033.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T14033 where
+
+newtype Zero = Zero
+newtype Succ a = Succ a
+
+type family Add n m :: * where
+     Add Zero m = m
+     Add (Succ n) m = Succ (Add n m)
diff --git a/testsuite/tests/indexed-types/should_fail/T14033.stderr b/testsuite/tests/indexed-types/should_fail/T14033.stderr
new file mode 100644
index 0000000000..fbc6b54486
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T14033.stderr
@@ -0,0 +1,6 @@
+
+T14033.hs:5:16: error:
+    • The constructor of a newtype must have exactly one field
+        but ‘Zero’ has none
+    • In the definition of data constructor ‘Zero’
+      In the newtype declaration for ‘Zero’
diff --git a/testsuite/tests/indexed-types/should_fail/T14045a.hs b/testsuite/tests/indexed-types/should_fail/T14045a.hs
new file mode 100644
index 0000000000..fc545a8d41
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T14045a.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs, FlexibleInstances #-}
+
+module T14045a where
+
+import Data.Kind
+
+class C (a :: k) where
+  data S (a :: k)
+
+instance C (z :: Bool) where
+  data S :: Bool -> Type where
+    SF :: S False
+    ST :: S True
diff --git a/testsuite/tests/indexed-types/should_fail/T14045a.stderr b/testsuite/tests/indexed-types/should_fail/T14045a.stderr
new file mode 100644
index 0000000000..0306bd2a07
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_fail/T14045a.stderr
@@ -0,0 +1,7 @@
+
+T14045a.hs:11:3: error:
+    • Type indexes must match class instance head
+      Expected: S z
+        Actual: S :: Bool -> Type
+    • In the data instance declaration for ‘S’
+      In the instance declaration for ‘C (z :: Bool)’
diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr
index e303e54f74..21af0d868a 100644
--- a/testsuite/tests/indexed-types/should_fail/T5934.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr
@@ -5,16 +5,3 @@ T5934.hs:12:7: error:
         GHC doesn't yet support impredicative polymorphism
     • In the expression: 0
       In an equation for ‘run’: run = 0
-
-T5934.hs:12:7: error:
-    • Ambiguous type variable ‘a0’ arising from the literal ‘0’
-      prevents the constraint ‘(Num a0)’ from being solved.
-      Probable fix: use a type annotation to specify what ‘a0’ should be.
-      These potential instances exist:
-        instance Num Integer -- Defined in ‘GHC.Num’
-        instance Num Double -- Defined in ‘GHC.Float’
-        instance Num Float -- Defined in ‘GHC.Float’
-        ...plus two others
-        (use -fprint-potential-instances to see them all)
-    • In the expression: 0
-      In an equation for ‘run’: run = 0
diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
index 8b3d5f5910..46521deeba 100644
--- a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
+++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr
@@ -1,6 +1,4 @@
 
-TyFamArity1.hs:4:23: error:
-    • Expecting one more argument to ‘IO’
-      Expected a type, but ‘IO’ has kind ‘* -> *’
-    • In the type ‘IO’
-      In the type instance declaration for ‘T’
+TyFamArity1.hs:4:15: error:
+    • Number of parameters must match family declaration; expected 2
+    • In the type instance declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
index 778d8ab9f4..8d48921946 100644
--- a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
+++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr
@@ -1,11 +1,4 @@
 
 TyFamArity2.hs:4:15: error:
-    • Too many parameters to T:
-        Float is unexpected;
-        expected only one parameter
+    • Number of parameters must match family declaration; expected 1
     • In the type instance declaration for ‘T’
-
-TyFamArity2.hs:4:29: error:
-    • Expected kind ‘* -> *’, but ‘Char’ has kind ‘*’
-    • In the type ‘Char’
-      In the type instance declaration for ‘T’
diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T
index 50257e6bb8..c3a2f16d6d 100644
--- a/testsuite/tests/indexed-types/should_fail/all.T
+++ b/testsuite/tests/indexed-types/should_fail/all.T
@@ -135,3 +135,6 @@ test('T7102a', normal, ghci_script, ['T7102a.script'])
 test('T13271', normal, compile_fail, [''])
 test('T13674', normal, compile_fail, [''])
 test('T13784', normal, compile_fail, [''])
+test('T13877', normal, compile_fail, [''])
+test('T14033', normal, compile_fail, [''])
+test('T14045a', normal, compile_fail, [''])
diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
index 663a7d7f2e..d96c448cf9 100644
--- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
@@ -275,5 +275,6 @@
        (FromSource)) 
       (WpHole) {NameSet: 
       []} 
-      []))]}))]}
+      []))]} 
+   (False)))]}
 
diff --git a/testsuite/tests/parser/should_fail/T7848.hs b/testsuite/tests/parser/should_fail/T7848.hs
index 25f0af7ee0..920f28e8c9 100644
--- a/testsuite/tests/parser/should_fail/T7848.hs
+++ b/testsuite/tests/parser/should_fail/T7848.hs
@@ -8,4 +8,4 @@ x (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h) = y
         y _ = (&)
         {-# INLINE (&) #-}
         {-# SPECIALIZE (&) :: a #-}
-        (&) = x
+        (&) = 'c'
diff --git a/testsuite/tests/parser/should_fail/T7848.stderr b/testsuite/tests/parser/should_fail/T7848.stderr
index 95ac7374ef..413920dbe6 100644
--- a/testsuite/tests/parser/should_fail/T7848.stderr
+++ b/testsuite/tests/parser/should_fail/T7848.stderr
@@ -1,13 +1,7 @@
 
-T7848.hs:6:1: error:
-    • Occurs check: cannot construct the infinite type:
-        t ~ p0 -> p1 -> A -> A -> A -> A -> p2 -> t
-    • Relevant bindings include x :: t (bound at T7848.hs:6:1)
-
 T7848.hs:10:9: error:
-    • Couldn't match expected type ‘t’ with actual type ‘a’
-        because type variable ‘a’ would escape its scope
-      This (rigid, skolem) type variable is bound by
+    • Couldn't match expected type ‘Char’ with actual type ‘a’
+      ‘a’ is a rigid type variable bound by
         the type signature for:
           (&) :: forall a. a
         at T7848.hs:10:9-35
@@ -20,5 +14,4 @@ T7848.hs:10:9: error:
                 y _ = (&)
                 {-# INLINE (&) #-}
                 {-# SPECIALIZE (&) :: a #-}
-                (&) = x
-    • Relevant bindings include x :: t (bound at T7848.hs:6:1)
+                (&) = 'c'
diff --git a/testsuite/tests/patsyn/should_compile/T13768.hs b/testsuite/tests/patsyn/should_compile/T13768.hs
new file mode 100644
index 0000000000..c4510bd20a
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T13768.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ViewPatterns #-}
+module T13768 where
+
+data NS (f :: k -> *) (xs :: [k]) = NS Int
+
+data IsNS (f :: k -> *) (xs :: [k]) where
+  IsZ :: f x -> IsNS f (x ': xs)
+  IsS :: NS f xs -> IsNS f (x ': xs)
+
+isNS :: NS f xs -> IsNS f xs
+isNS = undefined
+
+pattern Z :: () => (xs' ~ (x ': xs)) => f x -> NS f xs'
+pattern Z x <- (isNS -> IsZ x)
+
+pattern S :: () => (xs' ~ (x ': xs)) => NS f xs -> NS f xs'
+pattern S p <- (isNS -> IsS p)
+
+{-# COMPLETE Z, S #-}
+
+data SList :: [k] -> * where
+  SNil  :: SList '[]
+  SCons :: SList (x ': xs)
+
+go :: SList ys -> NS f ys -> Int
+go SCons (Z _) = 0
+go SCons (S _) = 1
+go SNil  _     = error "inaccessible"
diff --git a/testsuite/tests/patsyn/should_compile/T14058.hs b/testsuite/tests/patsyn/should_compile/T14058.hs
new file mode 100644
index 0000000000..7c263b8f44
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T14058.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeInType #-}
+module T14058 where
+
+import T14058a (Sing(..))
+
+foo :: Sing ('[ '[] ] :: [[a]])
+foo = SCons SNil SNil
diff --git a/testsuite/tests/patsyn/should_compile/T14058a.hs b/testsuite/tests/patsyn/should_compile/T14058a.hs
new file mode 100644
index 0000000000..a7e5d97b79
--- /dev/null
+++ b/testsuite/tests/patsyn/should_compile/T14058a.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+module T14058a (Sing(.., SCons)) where
+
+data family Sing (a :: k)
+
+data instance Sing (z :: [a]) where
+  SNil :: Sing '[]
+  (:%) :: Sing x -> Sing xs -> Sing (x:xs)
+
+pattern SCons :: forall a (z :: [a]). ()
+              => forall (x :: a) (xs :: [a]). z ~ (x:xs)
+              => Sing x -> Sing xs -> Sing z
+pattern SCons x xs = (:%) x xs
+{-# COMPLETE SNil, SCons #-}
diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T
index 30319c7050..b8c9806694 100644
--- a/testsuite/tests/patsyn/should_compile/all.T
+++ b/testsuite/tests/patsyn/should_compile/all.T
@@ -70,3 +70,6 @@ test('T13441b', normal, compile_fail, [''])
 test('T13454', normal, compile, [''])
 test('T13752', normal, compile, [''])
 test('T13752a', normal, compile, [''])
+test('T13768', normal, compile, [''])
+test('T14058', [extra_files(['T14058.hs', 'T14058a.hs'])],
+               multimod_compile, ['T14058', '-v0'])
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 03892714c7..baca57cf5e 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -444,7 +444,7 @@ test('T5631',
         # 2014-04-04:     346389856 (x86 Windows, 64 bit machine)
         # 2014-12-01:     390199244 (Windows laptop)
         # 2016-04-06:     570137436 (amd64/Linux) many reasons
-           (wordsize(64), 1037482512, 5)]),
+           (wordsize(64), 1106015512, 5)]),
         # expected value: 774595008 (amd64/Linux):
         # expected value: 735486328 (amd64/Linux) 2012/12/12:
         # expected value: 690742040 (amd64/Linux) Call Arity improvements
@@ -459,6 +459,8 @@ test('T5631',
         # 2017-02-17:     1517484488 (amd64/Linux) Type-indexed Typeable
         # 2017-03-03:     1065147968 (amd64/Linux) Share Typeable KindReps
         # 2017-03-31:     1037482512 (amd64/Linux) Fix memory leak in simplifier
+	# 2017-07-27:     1106015512 (Mac) Regresssion from tracking visibility in TypeEqOrigin
+	#                                  should be fixed by #14037
        only_ways(['normal'])
       ],
      compile,
diff --git a/testsuite/tests/pmcheck/should_compile/T14086.hs b/testsuite/tests/pmcheck/should_compile/T14086.hs
new file mode 100644
index 0000000000..de91229c24
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T14086.hs
@@ -0,0 +1,6 @@
+{-# language TypeInType, EmptyCase #-}
+module T14086 where
+import Data.Kind
+
+f :: Type -> Int
+f x = case x of
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index f44034b0d2..cabe23950b 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -41,6 +41,8 @@ test('T11276', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-pa
 test('T11303b', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS'])
 test('T11374', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS'])
 test('T11195', compile_timeout_multiplier(0.60), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS'])
+test('T14086', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 
 # Other tests
 test('pmc001', [], compile,
diff --git a/testsuite/tests/polykinds/KindVType.stderr b/testsuite/tests/polykinds/KindVType.stderr
index 7ce3404579..27e2e588a5 100644
--- a/testsuite/tests/polykinds/KindVType.stderr
+++ b/testsuite/tests/polykinds/KindVType.stderr
@@ -1,6 +1,6 @@
 
 KindVType.hs:8:8: error:
-    • Couldn't match type ‘*’ with ‘* -> *’
+    • Couldn't match type ‘Int’ with ‘Maybe’
       Expected type: Proxy Maybe
         Actual type: Proxy Int
     • In the expression: (Proxy :: Proxy Int)
diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr
index 4b551558a1..4dda0cddd5 100644
--- a/testsuite/tests/polykinds/T12593.stderr
+++ b/testsuite/tests/polykinds/T12593.stderr
@@ -1,7 +1,6 @@
 
 T12593.hs:11:16: error:
-    • Expecting two fewer arguments to ‘Free k k4 k5 p’
-      Expected kind ‘k0 -> k1 -> *’, but ‘Free k k4 k5 p’ has kind ‘*’
+    • Expected kind ‘k0 -> k1 -> *’, but ‘Free k k1 k2 p’ has kind ‘*’
     • In the type signature:
         run :: k2 q =>
                Free k k1 k2 p a b
@@ -20,12 +19,68 @@ T12593.hs:12:31: error:
                -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
 
 T12593.hs:12:40: error:
-    • Expecting two more arguments to ‘k4’
+    • Expecting two more arguments to ‘k1’
       Expected a type, but
-      ‘k4’ has kind
+      ‘k1’ has kind
       ‘((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *’
     • In the kind ‘k1’
       In the type signature:
         run :: k2 q =>
                Free k k1 k2 p a b
                -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
+
+T12593.hs:12:47: error:
+    • Couldn't match kind ‘(((k0 -> k1 -> *) -> Constraint)
+                            -> (k2 -> k3 -> *) -> *)
+                           -> Constraint’
+                     with ‘*’
+      When matching kinds
+        k :: (((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *)
+             -> Constraint
+        k2 :: *
+    • In the first argument of ‘p’, namely ‘c’
+      In the type signature:
+        run :: k2 q =>
+               Free k k1 k2 p a b
+               -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
+
+T12593.hs:12:49: error:
+    • Couldn't match kind ‘((k0 -> k1 -> *) -> Constraint)
+                           -> (k2 -> k3 -> *) -> *’
+                     with ‘*’
+      When matching kinds
+        k4 :: ((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *
+        k3 :: *
+    • In the second argument of ‘p’, namely ‘d’
+      In the type signature:
+        run :: k2 q =>
+               Free k k1 k2 p a b
+               -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
+
+T12593.hs:12:56: error:
+    • Couldn't match kind ‘(((k0 -> k1 -> *) -> Constraint)
+                            -> (k2 -> k3 -> *) -> *)
+                           -> Constraint’
+                     with ‘*’
+      When matching kinds
+        k :: (((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *)
+             -> Constraint
+        k0 :: *
+    • In the first argument of ‘q’, namely ‘c’
+      In the type signature:
+        run :: k2 q =>
+               Free k k1 k2 p a b
+               -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
+
+T12593.hs:12:58: error:
+    • Couldn't match kind ‘((k0 -> k1 -> *) -> Constraint)
+                           -> (k2 -> k3 -> *) -> *’
+                     with ‘*’
+      When matching kinds
+        k4 :: ((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *
+        k1 :: *
+    • In the second argument of ‘q’, namely ‘d’
+      In the type signature:
+        run :: k2 q =>
+               Free k k1 k2 p a b
+               -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b
diff --git a/testsuite/tests/polykinds/T13555.stderr b/testsuite/tests/polykinds/T13555.stderr
index eaea0335cf..e822f6e596 100644
--- a/testsuite/tests/polykinds/T13555.stderr
+++ b/testsuite/tests/polykinds/T13555.stderr
@@ -9,26 +9,7 @@ T13555.hs:25:14: error:
                      TaggedT m Maybe (CRTInfo (GF fp d))
         at T13555.hs:25:14-79
       Expected type: TaggedT m Maybe (CRTInfo (GF fp d))
-        Actual type: TaggedT m Maybe (CRTInfo (GF fp d))
-    • When checking that instance signature for ‘crtInfo’
-        is more general than its signature in the class
-        Instance sig: forall (m :: k0).
-                      Reflects m Int =>
-                      TaggedT m Maybe (CRTInfo (GF fp d))
-           Class sig: forall k2 (m :: k2).
-                      Reflects m Int =>
-                      TaggedT m Maybe (CRTInfo (GF fp d))
-      In the instance declaration for ‘CRTrans Maybe (GF fp d)’
-
-T13555.hs:25:14: error:
-    • Could not deduce (Reflects m Int)
-      from the context: Reflects m Int
-        bound by the type signature for:
-                   crtInfo :: forall k2 (m :: k2).
-                              Reflects m Int =>
-                              TaggedT m Maybe (CRTInfo (GF fp d))
-        at T13555.hs:25:14-79
-      The type variable ‘k0’ is ambiguous
+        Actual type: TaggedT m0 Maybe (CRTInfo (GF fp d))
     • When checking that instance signature for ‘crtInfo’
         is more general than its signature in the class
         Instance sig: forall (m :: k0).
diff --git a/testsuite/tests/polykinds/T6039.stderr b/testsuite/tests/polykinds/T6039.stderr
index 4c31bb4aa4..048efd538f 100644
--- a/testsuite/tests/polykinds/T6039.stderr
+++ b/testsuite/tests/polykinds/T6039.stderr
@@ -1,5 +1,4 @@
 
 T6039.hs:5:14: error:
-    • Expecting one fewer arguments to ‘j’
-      Expected kind ‘* -> *’, but ‘j’ has kind ‘*’
+    • Expected kind ‘* -> *’, but ‘j’ has kind ‘*’
     • In the kind ‘j k’
diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr
index 676be2cb0f..265e27892b 100644
--- a/testsuite/tests/polykinds/T7278.stderr
+++ b/testsuite/tests/polykinds/T7278.stderr
@@ -1,6 +1,5 @@
 
 T7278.hs:9:43: error:
-    • Expecting two fewer arguments to ‘t’
-      Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’
+    • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’
     • In the type signature:
         f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0
diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr
index a198657754..6c4eec47f2 100644
--- a/testsuite/tests/polykinds/T7438.stderr
+++ b/testsuite/tests/polykinds/T7438.stderr
@@ -1,16 +1,16 @@
 
 T7438.hs:6:14: error:
     • Couldn't match expected type ‘p1’ with actual type ‘p’
-        ‘p1’ is untouchable
+        ‘p’ is untouchable
           inside the constraints: b ~ a
           bound by a pattern with constructor:
                      Nil :: forall k (a :: k). Thrist a a,
                    in an equation for ‘go’
           at T7438.hs:6:4-6
-      ‘p1’ is a rigid type variable bound by
-        the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16
       ‘p’ is a rigid type variable bound by
         the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16
+      ‘p1’ is a rigid type variable bound by
+        the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16
       Possible fix: add a type signature for ‘go’
     • In the expression: acc
       In an equation for ‘go’: go Nil acc = acc
diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr
index 1e7818c5ef..0794442edc 100644
--- a/testsuite/tests/polykinds/T8566.stderr
+++ b/testsuite/tests/polykinds/T8566.stderr
@@ -1,6 +1,6 @@
 
 T8566.hs:32:9: error:
-    • Could not deduce (C ('AA (t (I a ps)) as) ps fs0)
+    • Could not deduce (C ('AA (t1 (I a ps)) as) ps fs0)
         arising from a use of ‘c’
       from the context: C ('AA (t (I a ps)) as) ps fs
         bound by the instance declaration at T8566.hs:30:10-67
diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr
index 00c9c6328e..6249bf7b62 100644
--- a/testsuite/tests/polykinds/T8616.stderr
+++ b/testsuite/tests/polykinds/T8616.stderr
@@ -1,6 +1,6 @@
 
 T8616.hs:8:29: error:
-    • Expected a type, but ‘Any’ has kind ‘k’
+    • Expected a type, but ‘(Any :: k)’ has kind ‘k’
     • In an expression type signature: (Any :: k)
       In the expression: undefined :: (Any :: k)
       In an equation for ‘withSomeSing’:
diff --git a/testsuite/tests/polykinds/T9017.stderr b/testsuite/tests/polykinds/T9017.stderr
index 79a9a4617f..d9483c8490 100644
--- a/testsuite/tests/polykinds/T9017.stderr
+++ b/testsuite/tests/polykinds/T9017.stderr
@@ -1,12 +1,16 @@
 
 T9017.hs:8:7: error:
-    • Couldn't match kind ‘k’ with ‘*’
-      ‘k’ is a rigid type variable bound by
+    • Couldn't match kind ‘k1’ with ‘*’
+      ‘k1’ is a rigid type variable bound by
         the type signature for:
           foo :: forall k k1 (a :: k -> k1 -> *) (b :: k) (m :: k -> k1).
                  a b (m b)
         at T9017.hs:7:1-16
-      When matching the kind of ‘a’
+      When matching types
+        a1 :: * -> * -> *
+        a :: k -> k1 -> *
+      Expected type: a b (m b)
+        Actual type: a1 a0 (m0 a0)
     • In the expression: arr return
       In an equation for ‘foo’: foo = arr return
     • Relevant bindings include
diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr
index 22f9df73f1..7c3cb65bd0 100644
--- a/testsuite/tests/polykinds/T9200b.stderr
+++ b/testsuite/tests/polykinds/T9200b.stderr
@@ -1,5 +1,5 @@
 
 T9200b.hs:8:5: error:
-    Expected kind ‘k’, but ‘'True’ has kind ‘Bool’
-    In the first argument of ‘F’, namely ‘True’
-    In the type family declaration for ‘F’
+    • Expected kind ‘k’, but ‘True’ has kind ‘Bool’
+    • In the first argument of ‘F’, namely ‘True’
+      In the type family declaration for ‘F’
diff --git a/testsuite/tests/programs/galois_raytrace/Eval.hs b/testsuite/tests/programs/galois_raytrace/Eval.hs
index bf43d10605..001842edad 100644
--- a/testsuite/tests/programs/galois_raytrace/Eval.hs
+++ b/testsuite/tests/programs/galois_raytrace/Eval.hs
@@ -243,7 +243,7 @@ doPrimOp primOp op args
           show op ++ " takes " ++ show (length types) ++ " argument" ++ s
                    ++ " with" ++ the ++ " type" ++ s ++ "\n|\n|" ++
           "      " ++ unwords [ show ty | ty <- types ]  ++ "\n|\n|" ++
-          " currently, the relevent argument" ++ s ++ " on the stack " ++
+          " currently, the relevant argument" ++ s ++ " on the stack " ++
                   are ++ "\n|\n| " ++
           unwords [ "(" ++ show arg ++ ")"
                   | arg <-  reverse (take (length types) args) ]  ++ "\n|\n| "
diff --git a/testsuite/tests/quasiquotation/Makefile b/testsuite/tests/quasiquotation/Makefile
index 8e2e7e7c78..ebc91d23e5 100644
--- a/testsuite/tests/quasiquotation/Makefile
+++ b/testsuite/tests/quasiquotation/Makefile
@@ -9,3 +9,7 @@ T4150:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150A.hs
 	-'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150.hs
 
+T14028:
+	'$(TEST_HC)' $(TEST_HC_OPTS) T14028Quote.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T14028C.c
+	'$(TEST_HC)' $(TEST_HC_OPTS) -fexternal-interpreter T14028 T14028C.o
diff --git a/testsuite/tests/quasiquotation/T14028.hs b/testsuite/tests/quasiquotation/T14028.hs
new file mode 100644
index 0000000000..5313df6e77
--- /dev/null
+++ b/testsuite/tests/quasiquotation/T14028.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+import T14028Quote
+
+s :: String
+s = [here|goes nothing|]
+
+main = putStrLn s
diff --git a/testsuite/tests/quasiquotation/T14028C.c b/testsuite/tests/quasiquotation/T14028C.c
new file mode 100644
index 0000000000..0115013d70
--- /dev/null
+++ b/testsuite/tests/quasiquotation/T14028C.c
@@ -0,0 +1,5 @@
+#include <stdio.h>
+
+void hi() {
+  puts("Hello, World!");
+}
diff --git a/testsuite/tests/quasiquotation/T14028Quote.hs b/testsuite/tests/quasiquotation/T14028Quote.hs
new file mode 100644
index 0000000000..01413ec100
--- /dev/null
+++ b/testsuite/tests/quasiquotation/T14028Quote.hs
@@ -0,0 +1,6 @@
+module T14028Quote where
+import Language.Haskell.TH
+import Language.Haskell.TH.Quote
+
+here :: QuasiQuoter
+here = QuasiQuoter { quoteExp  = litE . stringL }
diff --git a/testsuite/tests/quasiquotation/all.T b/testsuite/tests/quasiquotation/all.T
index 84d25f8bdd..a10b8e4446 100644
--- a/testsuite/tests/quasiquotation/all.T
+++ b/testsuite/tests/quasiquotation/all.T
@@ -6,3 +6,7 @@ test('T7918',
      [req_interp, extra_run_opts('"' + config.libdir + '"'),
       only_ways(config.ghc_th_way), unless(have_dynamic(), skip)],
      compile_and_run, ['-package ghc ' + config.ghc_th_way_flags])
+test('T14028',
+     [req_interp, only_ways(config.ghc_th_way)],
+     run_command,
+     ['$MAKE -s --no-print-directory T14028'])
diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr
index a5af954e82..41eb9882e8 100644
--- a/testsuite/tests/quotes/TH_localname.stderr
+++ b/testsuite/tests/quotes/TH_localname.stderr
@@ -5,7 +5,7 @@ TH_localname.hs:3:11: error:
                                   t0)’ from being solved.
       Relevant bindings include
         y :: t0 (bound at TH_localname.hs:3:6)
-        x :: t0 -> Language.Haskell.TH.Lib.ExpQ
+        x :: t0 -> Language.Haskell.TH.Lib.Internal.ExpQ
           (bound at TH_localname.hs:3:1)
       Probable fix: use a type annotation to specify what ‘t0’ should be.
       These potential instances exist:
diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr b/testsuite/tests/rename/should_fail/rnfail026.stderr
index dc6ee9691a..8bd80b1b58 100644
--- a/testsuite/tests/rename/should_fail/rnfail026.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail026.stderr
@@ -1,7 +1,6 @@
 
 rnfail026.hs:16:27: error:
-    • Expecting one fewer arguments to ‘Set a’
-      Expected kind ‘* -> *’, but ‘Set a’ has kind ‘*’
+    • Expected kind ‘* -> *’, but ‘Set a’ has kind ‘*’
     • In the first argument of ‘Monad’, namely
         ‘(forall a. Eq a => Set a)’
       In the instance declaration for ‘Monad (forall a. Eq a => Set a)’
diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr
index f4b44a28c4..414ef801d5 100644
--- a/testsuite/tests/roles/should_compile/Roles13.stderr
+++ b/testsuite/tests/roles/should_compile/Roles13.stderr
@@ -13,7 +13,7 @@ convert :: Wrap Age -> Int
 [GblId, Arity=1, Caf=NoCafRefs]
 convert
   = convert1
-    `cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0]
+    `cast` (<Wrap Age>_R ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0])
             :: (Wrap Age -> Wrap Age :: *) ~R# (Wrap Age -> Int :: *))
 
 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/roles/should_compile/T14101.hs b/testsuite/tests/roles/should_compile/T14101.hs
new file mode 100644
index 0000000000..3a23b5af70
--- /dev/null
+++ b/testsuite/tests/roles/should_compile/T14101.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE RoleAnnotations #-}
+module T14101 where
+
+type role Array representational
+data Array a
+
+type Arr = Array
+
+data Foo a = Foo (Arr a)
+type role Foo representational
diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T
index c0b0d827c9..8d7c31f4da 100644
--- a/testsuite/tests/roles/should_compile/all.T
+++ b/testsuite/tests/roles/should_compile/all.T
@@ -7,3 +7,4 @@ test('Roles14', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques'])
 test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques -fprint-typechecker-elaboration'])
 test('T10263', normal, compile, [''])
 test('T9204b', [], multimod_compile, ['T9204b', '-v0'])
+test('T14101', normal, compile, [''])
diff --git a/testsuite/tests/rts/T6006.stdout-mingw32 b/testsuite/tests/rts/T6006.stdout-mingw32
index 42e57fde57..962ec4b280 100644
--- a/testsuite/tests/rts/T6006.stdout-mingw32
+++ b/testsuite/tests/rts/T6006.stdout-mingw32
@@ -1,2 +1,2 @@
-"T6006.exe"
+"T6006"
 []
diff --git a/testsuite/tests/rts/flags/Makefile b/testsuite/tests/rts/flags/Makefile
new file mode 100644
index 0000000000..61900477f9
--- /dev/null
+++ b/testsuite/tests/rts/flags/Makefile
@@ -0,0 +1,6 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T1791:
+	'$(TEST_HC)' T1791.hs -o T1791 -O -rtsopts
diff --git a/testsuite/tests/rts/flags/T12870.hs b/testsuite/tests/rts/flags/T12870.hs
new file mode 100644
index 0000000000..8d536d58d6
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870.hs
@@ -0,0 +1,6 @@
+module T12870 where
+
+import System.Environment
+
+main :: IO ()
+main = getArgs >>= putStr . show
diff --git a/testsuite/tests/rts/flags/T12870_.stdout b/testsuite/tests/rts/flags/T12870_.stdout
new file mode 100644
index 0000000000..1b04d8a31c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870_.stdout
@@ -0,0 +1 @@
+Heap overflow caught!
diff --git a/testsuite/tests/rts/flags/T12870a.stdout b/testsuite/tests/rts/flags/T12870a.stdout
new file mode 100644
index 0000000000..495a52faf3
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870a.stdout
@@ -0,0 +1 @@
+["arg1","+RTS","arg2"]
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870c.stderr b/testsuite/tests/rts/flags/T12870c.stderr
new file mode 100644
index 0000000000..0545774941
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870c.stderr
@@ -0,0 +1 @@
+T12870c.exe: Most RTS options are disabled. Link with -rtsopts to enable them.
diff --git a/testsuite/tests/rts/flags/T12870d.stdout b/testsuite/tests/rts/flags/T12870d.stdout
new file mode 100644
index 0000000000..495a52faf3
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870d.stdout
@@ -0,0 +1 @@
+["arg1","+RTS","arg2"]
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870e.stdout b/testsuite/tests/rts/flags/T12870e.stdout
new file mode 100644
index 0000000000..4859ab454c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870e.stdout
@@ -0,0 +1 @@
+["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870f.stdout b/testsuite/tests/rts/flags/T12870f.stdout
new file mode 100644
index 0000000000..4859ab454c
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870f.stdout
@@ -0,0 +1 @@
+["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870g.hs b/testsuite/tests/rts/flags/T12870g.hs
new file mode 100644
index 0000000000..e409349827
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870g.hs
@@ -0,0 +1,8 @@
+module T12870g where
+
+import GHC.RTS.Flags (getGCFlags, generations)
+
+main :: IO ()
+main = do
+    gcFlags <- getGCFlags
+    putStr . show $ generations gcFlags
diff --git a/testsuite/tests/rts/flags/T12870g.stdout b/testsuite/tests/rts/flags/T12870g.stdout
new file mode 100644
index 0000000000..c7930257df
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870g.stdout
@@ -0,0 +1 @@
+7
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/T12870h.stdout b/testsuite/tests/rts/flags/T12870h.stdout
new file mode 100644
index 0000000000..e440e5c842
--- /dev/null
+++ b/testsuite/tests/rts/flags/T12870h.stdout
@@ -0,0 +1 @@
+3
+\ No newline at end of file
diff --git a/testsuite/tests/rts/flags/all.T b/testsuite/tests/rts/flags/all.T
new file mode 100644
index 0000000000..33a28e500a
--- /dev/null
+++ b/testsuite/tests/rts/flags/all.T
@@ -0,0 +1,44 @@
+#Standard handling of RTS arguments
+test('T12870a',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts -main-is T12870'])
+
+test('T12870b',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']),
+        exit_code(1), ignore_stderr],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=none -main-is T12870'])
+
+test('T12870c',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']),
+    exit_code(1)],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=some -main-is T12870'])
+
+test('T12870d',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-main-is T12870'])
+
+#RTS options should be passed along to the program
+test('T12870e',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=ignore -main-is T12870'])
+test('T12870f',
+    [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs'])],
+    multimod_compile_and_run,
+    ['T12870', '-rtsopts=ignoreAll -main-is T12870'])
+
+#Check handling of env variables
+test('T12870g',
+    [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs'])],
+    multimod_compile_and_run,
+    ['T12870g', '-rtsopts -main-is T12870g -with-rtsopts="-G3"'])
+
+test('T12870h',
+    [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs'])],
+    multimod_compile_and_run,
+    ['T12870g', '-rtsopts=ignoreAll -main-is T12870g -with-rtsopts="-G3"'])
+
diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs
index b8ec6df6d1..5243445c96 100644
--- a/testsuite/tests/stranal/should_compile/T9208.hs
+++ b/testsuite/tests/stranal/should_compile/T9208.hs
@@ -25,6 +25,7 @@ import           Control.Monad
 #if __GLASGOW_HASKELL__ >= 800
 import           Control.Monad.Fail (MonadFail(fail))
 #endif
+import           Control.Monad.IO.Class (MonadIO (..))
 
 import           Data.Binary
 import           Data.Binary.Get
@@ -81,7 +82,8 @@ instance MonadFail GHCJSQ where
   fail = undefined
 #endif
 
-instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m
+instance MonadIO GHCJSQ where liftIO m = GHCJSQ $ \s -> fmap (,s) m
+instance TH.Quasi GHCJSQ
 
 -- | the Template Haskell server
 runTHServer :: IO ()
diff --git a/testsuite/tests/th/T13642.hs b/testsuite/tests/th/T13642.hs
index 35aee30ddb..090b891433 100644
--- a/testsuite/tests/th/T13642.hs
+++ b/testsuite/tests/th/T13642.hs
@@ -5,5 +5,5 @@ import Data.Kind (Type)
 import Language.Haskell.TH (stringE, pprint)
 
 foo :: IO ()
-foo = $([d| data Foo :: forall a. a -> Type where MkFoo :: Foo Int |]
-         >>= \d -> stringE (pprint d))
+foo = putStrLn $([d| data Foo :: forall a. a -> Type where MkFoo :: Foo Int |]
+                 >>= \d -> stringE (pprint d))
diff --git a/testsuite/tests/th/T13642.stderr b/testsuite/tests/th/T13642.stderr
deleted file mode 100644
index a6ff054a26..0000000000
--- a/testsuite/tests/th/T13642.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-
-T13642.hs:8:9: error:
-    Exotic form of kind not (yet) handled by Template Haskell
-      forall a. a -> Type
diff --git a/testsuite/tests/th/T13837.hs b/testsuite/tests/th/T13837.hs
new file mode 100644
index 0000000000..3d33341e4d
--- /dev/null
+++ b/testsuite/tests/th/T13837.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T13837 where
+
+import Language.Haskell.TH.Lib
+import Language.Haskell.TH.Syntax
+
+test_local_tyfam_expansion :: String
+test_local_tyfam_expansion =
+  $(do fam_name <- newName "Fam"
+       stringE . show =<< qReifyInstances fam_name [])
diff --git a/testsuite/tests/th/T13837.stderr b/testsuite/tests/th/T13837.stderr
new file mode 100644
index 0000000000..53700b5a7a
--- /dev/null
+++ b/testsuite/tests/th/T13837.stderr
@@ -0,0 +1,10 @@
+
+T13837.hs:9:5: error:
+    • The exact Name ‘Fam’ is not in scope
+        Probable cause: you used a unique Template Haskell name (NameU), 
+        perhaps via newName, but did not bind it
+        If that's it, then -ddump-splices might be useful
+    • In the argument of reifyInstances: Fam_0
+      In the untyped splice:
+        $(do fam_name <- newName "Fam"
+             stringE . show =<< qReifyInstances fam_name [])
diff --git a/testsuite/tests/th/T13887.hs b/testsuite/tests/th/T13887.hs
new file mode 100644
index 0000000000..8687447d16
--- /dev/null
+++ b/testsuite/tests/th/T13887.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Data.Proxy
+import GHC.Generics
+import Language.Haskell.TH
+
+main :: IO ()
+main = do
+  putStrLn $([t| Proxy  (:*:) |] >>= stringE . pprint)
+  putStrLn $([t| Proxy '(:*:) |] >>= stringE . pprint)
+  putStrLn $([t| Proxy '(:)   |] >>= stringE . pprint)
diff --git a/testsuite/tests/th/T13887.stdout b/testsuite/tests/th/T13887.stdout
new file mode 100644
index 0000000000..48845be60a
--- /dev/null
+++ b/testsuite/tests/th/T13887.stdout
@@ -0,0 +1,3 @@
+Data.Proxy.Proxy (GHC.Generics.:*:)
+Data.Proxy.Proxy '(GHC.Generics.:*:)
+Data.Proxy.Proxy '(GHC.Types.:)
diff --git a/testsuite/tests/th/T13968.hs b/testsuite/tests/th/T13968.hs
new file mode 100644
index 0000000000..1e54ef12f3
--- /dev/null
+++ b/testsuite/tests/th/T13968.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T13968 where
+
+import Language.Haskell.TH
+
+$(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []])
diff --git a/testsuite/tests/th/T13968.stderr b/testsuite/tests/th/T13968.stderr
new file mode 100644
index 0000000000..2850dae0c5
--- /dev/null
+++ b/testsuite/tests/th/T13968.stderr
@@ -0,0 +1,3 @@
+
+T13968.hs:6:3: error:
+    Cannot redefine a Name retrieved by a Template Haskell quote: succ
diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr
index e2e8cadbdc..d68be6d1fc 100644
--- a/testsuite/tests/th/T3177a.stderr
+++ b/testsuite/tests/th/T3177a.stderr
@@ -1,10 +1,8 @@
 
 T3177a.hs:8:8: error:
-    • Expecting one fewer arguments to ‘Int’
-      Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
+    • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
     • In the type signature: f :: (Int Int)
 
 T3177a.hs:11:6: error:
-    • Expecting one fewer arguments to ‘Int’
-      Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
+    • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
     • In the type signature: g :: Int Int
diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr
index 4bfc53a78e..b698bc1004 100644
--- a/testsuite/tests/th/T5358.stderr
+++ b/testsuite/tests/th/T5358.stderr
@@ -1,4 +1,24 @@
 
+T5358.hs:10:13: error:
+    • Couldn't match expected type ‘t -> a0’ with actual type ‘Int’
+    • The function ‘T5358.t1’ is applied to one argument,
+      but its type ‘Int’ has none
+      In the first argument of ‘(==)’, namely ‘T5358.t1 x’
+      In the expression: T5358.t1 x == T5358.t2 x
+    • Relevant bindings include
+        x :: t (bound at T5358.hs:10:9)
+        T5358.prop_x1 :: t -> Bool (bound at T5358.hs:10:1)
+
+T5358.hs:10:21: error:
+    • Couldn't match expected type ‘t -> a0’ with actual type ‘Int’
+    • The function ‘T5358.t2’ is applied to one argument,
+      but its type ‘Int’ has none
+      In the second argument of ‘(==)’, namely ‘T5358.t2 x’
+      In the expression: T5358.t1 x == T5358.t2 x
+    • Relevant bindings include
+        x :: t (bound at T5358.hs:10:9)
+        T5358.prop_x1 :: t -> Bool (bound at T5358.hs:10:1)
+
 T5358.hs:14:12: error:
     • Exception when trying to run compile-time code:
         runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr
index 93c9a0c835..4fa2a3c4c9 100644
--- a/testsuite/tests/th/T7276.stderr
+++ b/testsuite/tests/th/T7276.stderr
@@ -2,7 +2,7 @@
 T7276.hs:6:8: error:
     • Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’
                      with ‘Language.Haskell.TH.Syntax.Exp’
-      Expected type: Language.Haskell.TH.Lib.ExpQ
-        Actual type: Language.Haskell.TH.Lib.DecsQ
+      Expected type: Language.Haskell.TH.Lib.Internal.ExpQ
+        Actual type: Language.Haskell.TH.Lib.Internal.DecsQ
     • In the expression: [d| y = 3 |]
       In the untyped splice: $([d| y = 3 |])
diff --git a/testsuite/tests/th/TH_PromotedList.stderr b/testsuite/tests/th/TH_PromotedList.stderr
index 8a6422f6ec..fde888ff88 100644
--- a/testsuite/tests/th/TH_PromotedList.stderr
+++ b/testsuite/tests/th/TH_PromotedList.stderr
@@ -1,3 +1,3 @@
 
-TH_PromotedList.hs:11:3: Warning:
-    (':) GHC.Types.Int ((':) GHC.Types.Bool '[])
+TH_PromotedList.hs:11:3: warning:
+    '(:) GHC.Types.Int ('(:) GHC.Types.Bool '[])
diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr
index 11829296e0..6b0662218a 100644
--- a/testsuite/tests/th/TH_RichKinds2.stderr
+++ b/testsuite/tests/th/TH_RichKinds2.stderr
@@ -5,5 +5,6 @@ TH_RichKinds2.hs:24:4: warning:
     SJust_4 :: (s_5 a_6) -> SMaybe_0 s_5 ('GHC.Base.Just a_6)
 type instance TH_RichKinds2.Map f_7 '[] = '[]
 type instance TH_RichKinds2.Map f_8
-                                ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9)
-                                                                       (TH_RichKinds2.Map f_8 t_10)
+                                ('(GHC.Types.:) h_9 t_10) = '(GHC.Types.:) (f_8 h_9)
+                                                                           (TH_RichKinds2.Map f_8
+                                                                                              t_10)
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index f89be6e0bb..29a6334f6b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -386,7 +386,10 @@ test('T13473', normal, multimod_compile_and_run,
      ['T13473.hs', '-v0 ' + config.ghc_th_way_flags])
 test('T13587', expect_broken(13587), compile_and_run, ['-v0'])
 test('T13618', normal, compile_and_run, ['-v0'])
-test('T13642', normal, compile_fail, ['-v0'])
+test('T13642', normal, compile, ['-v0'])
 test('T13781', normal, compile, ['-v0'])
 test('T13782', normal, compile, [''])
+test('T13837', normal, compile_fail, ['-v0 -dsuppress-uniques'])
 test('T13856', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
+test('T13887', normal, compile_and_run, ['-v0'])
+test('T13968', normal, compile_fail, ['-v0'])
diff --git a/testsuite/tests/typecheck/should_compile/T13594.stderr b/testsuite/tests/typecheck/should_compile/T13594.stderr
new file mode 100644
index 0000000000..57810cc1e6
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13594.stderr
@@ -0,0 +1,3 @@
+
+T13594.hs:8:1: error:
+    Top-level strict bindings aren't allowed: !x = (1, 2)
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 2ce4e91fa8..c18c73b9bc 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -556,7 +556,7 @@ test('T13474', normal, compile, [''])
 test('T13524', normal, compile, [''])
 test('T13509', normal, compile, [''])
 test('T13526', normal, compile, [''])
-test('T13594', normal, compile, [''])
+test('T13594', normal, compile_fail, [''])
 test('T13603', normal, compile, [''])
 test('T13333', normal, compile, [''])
 test('T13585', [extra_files(['T13585.hs', 'T13585a.hs', 'T13585b.hs'])], run_command, ['$MAKE -s --no-print-directory T13585'])
diff --git a/testsuite/tests/typecheck/should_fail/T11356.stderr b/testsuite/tests/typecheck/should_fail/T11356.stderr
index aa1db97c62..e0224022a2 100644
--- a/testsuite/tests/typecheck/should_fail/T11356.stderr
+++ b/testsuite/tests/typecheck/should_fail/T11356.stderr
@@ -1,5 +1,4 @@
 
 T11356.hs:3:7: error:
-    • Expecting one fewer arguments to ‘T p’
-      Expected kind ‘k0 -> Constraint’, but ‘T p’ has kind ‘Constraint’
+    • Expected kind ‘k0 -> Constraint’, but ‘T p’ has kind ‘Constraint’
     • In the class declaration for ‘C’
diff --git a/testsuite/tests/typecheck/should_fail/T11672.hs b/testsuite/tests/typecheck/should_fail/T11672.hs
new file mode 100644
index 0000000000..8c5e2fba6e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11672.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+module BadError where
+
+import GHC.TypeLits
+import Data.Proxy
+
+f :: Proxy (a :: Symbol) -> Int
+f _ = f (Proxy :: Proxy (Int -> Bool))
diff --git a/testsuite/tests/typecheck/should_fail/T11672.stderr b/testsuite/tests/typecheck/should_fail/T11672.stderr
new file mode 100644
index 0000000000..16eb31042f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11672.stderr
@@ -0,0 +1,12 @@
+
+T11672.hs:9:10: error:
+    • Couldn't match kind ‘*’ with ‘Symbol’
+      When matching types
+        a0 :: Symbol
+        Int -> Bool :: *
+      Expected type: Proxy a0
+        Actual type: Proxy (Int -> Bool)
+    • In the first argument of ‘f’, namely
+        ‘(Proxy :: Proxy (Int -> Bool))’
+      In the expression: f (Proxy :: Proxy (Int -> Bool))
+      In an equation for ‘f’: f _ = f (Proxy :: Proxy (Int -> Bool))
diff --git a/testsuite/tests/typecheck/should_fail/T11963.hs b/testsuite/tests/typecheck/should_fail/T11963.hs
new file mode 100644
index 0000000000..c4f78aee29
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11963.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-}
+
+module T11963 where
+
+-- this module should be rejected without TypeInType
+
+import Data.Proxy
+
+-- see code in RnTypes.extract_hs_tv_bndrs which checks for these bad cases
+
+  -- bndr_kvs vs body_tvs
+data Typ k t  where
+    Typ :: (forall (a :: k -> *). a t -> a t) -> Typ k t
+
+  -- bndr_kvs vs acc_tvs
+foo :: (forall (t :: k). Proxy t) -> Proxy k
+foo _ = undefined
+
+  -- locals vs body_kvs
+bar :: forall k. forall (t :: k). Proxy t
+bar = undefined
+
+  -- body_kvs vs acc_tvs
+quux :: (forall t. Proxy (t :: k)) -> Proxy k
+quux _ = undefined
+
+  -- body_tvs vs acc_kvs
+blargh :: (forall a. a -> Proxy k) -> Proxy (t :: k)
+blargh _ = undefined
diff --git a/testsuite/tests/typecheck/should_fail/T11963.stderr b/testsuite/tests/typecheck/should_fail/T11963.stderr
new file mode 100644
index 0000000000..74c3ab0ee1
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T11963.stderr
@@ -0,0 +1,20 @@
+
+T11963.hs:13:26: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:16:22: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:20:15: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:24:32: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
+
+T11963.hs:28:33: error:
+    Variable ‘k’ used as both a kind and a type
+    Did you intend to use TypeInType?
diff --git a/testsuite/tests/typecheck/should_fail/T12373.hs b/testsuite/tests/typecheck/should_fail/T12373.hs
new file mode 100644
index 0000000000..3f23779b82
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12373.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-}
+
+module T12373 where
+
+import GHC.MVar
+import GHC.Prim
+import GHC.Types
+
+main :: IO ()
+main = IO (\rw -> newMVar# rw) >> return ()
diff --git a/testsuite/tests/typecheck/should_fail/T12373.stderr b/testsuite/tests/typecheck/should_fail/T12373.stderr
new file mode 100644
index 0000000000..d3a4bb5e65
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T12373.stderr
@@ -0,0 +1,11 @@
+
+T12373.hs:10:19: error:
+    • Couldn't match a lifted type with an unlifted type
+      When matching types
+        a1 :: *
+        MVar# RealWorld a0 :: TYPE 'UnliftedRep
+      Expected type: (# State# RealWorld, a1 #)
+        Actual type: (# State# RealWorld, MVar# RealWorld a0 #)
+    • In the expression: newMVar# rw
+      In the first argument of ‘IO’, namely ‘(\ rw -> newMVar# rw)’
+      In the first argument of ‘(>>)’, namely ‘IO (\ rw -> newMVar# rw)’
diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr
index 1b1d1bc569..b8e572d6e2 100644
--- a/testsuite/tests/typecheck/should_fail/T12785b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr
@@ -8,6 +8,12 @@ T12785b.hs:29:63: error:
                              a -> HTree n (HTree ('S n) a) -> HTree ('S n) a,
                  in an equation for ‘nest’
         at T12785b.hs:29:7-51
+      ‘s’ is a rigid type variable bound by
+        a pattern with constructor:
+          Hide :: forall a (n :: Peano) (f :: a -> *) (s :: HTree n a).
+                  STree n a f s -> Hidden n f,
+        in an equation for ‘nest’
+        at T12785b.hs:29:7-12
     • In the second argument of ‘($)’, namely ‘a `SBranchX` tr’
       In the expression: Hide $ a `SBranchX` tr
       In an equation for ‘nest’:
diff --git a/testsuite/tests/typecheck/should_fail/T13530.hs b/testsuite/tests/typecheck/should_fail/T13530.hs
new file mode 100644
index 0000000000..9f95e497f2
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13530.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+module T13530 where
+
+import GHC.Exts
+
+g :: Int -> (# Int#, a #)
+g (I# y) = (# y, undefined #)
+
+f :: Int -> (# Int#, Int# #)
+f x = g x
diff --git a/testsuite/tests/typecheck/should_fail/T13530.stderr b/testsuite/tests/typecheck/should_fail/T13530.stderr
new file mode 100644
index 0000000000..139c1b0f34
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13530.stderr
@@ -0,0 +1,10 @@
+
+T13530.hs:11:7: error:
+    • Couldn't match a lifted type with an unlifted type
+      When matching types
+        a0 :: *
+        Int# :: TYPE 'IntRep
+      Expected type: (# Int#, Int# #)
+        Actual type: (# Int#, a0 #)
+    • In the expression: g x
+      In an equation for ‘f’: f x = g x
diff --git a/testsuite/tests/typecheck/should_fail/T13610.hs b/testsuite/tests/typecheck/should_fail/T13610.hs
new file mode 100644
index 0000000000..371c3388e9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13610.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MagicHash #-}
+
+module T13610 where
+
+import GHC.Prim
+import GHC.Types
+
+main = do
+    let primDouble = 0.42## :: Double#
+    let double = 0.42 :: Double
+    IO (\s -> mkWeakNoFinalizer# double () s)
diff --git a/testsuite/tests/typecheck/should_fail/T13610.stderr b/testsuite/tests/typecheck/should_fail/T13610.stderr
new file mode 100644
index 0000000000..0755ce9371
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13610.stderr
@@ -0,0 +1,14 @@
+
+T13610.hs:11:15: error:
+    • Couldn't match a lifted type with an unlifted type
+      When matching types
+        a :: *
+        Weak# () :: TYPE 'UnliftedRep
+      Expected type: (# State# RealWorld, a #)
+        Actual type: (# State# RealWorld, Weak# () #)
+    • In the expression: mkWeakNoFinalizer# double () s
+      In the first argument of ‘IO’, namely
+        ‘(\ s -> mkWeakNoFinalizer# double () s)’
+      In a stmt of a 'do' block:
+        IO (\ s -> mkWeakNoFinalizer# double () s)
+    • Relevant bindings include main :: IO a (bound at T13610.hs:8:1)
diff --git a/testsuite/tests/typecheck/should_fail/T13819.hs b/testsuite/tests/typecheck/should_fail/T13819.hs
new file mode 100644
index 0000000000..5244ddc840
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13819.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveFunctor, TypeApplications #-}
+
+module T13819 where
+
+import Data.Coerce
+import Control.Applicative
+
+newtype A a = A (IO a)
+  deriving Functor
+
+instance Applicative A where
+  pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure
+
+instance Monad A where
diff --git a/testsuite/tests/typecheck/should_fail/T13819.stderr b/testsuite/tests/typecheck/should_fail/T13819.stderr
new file mode 100644
index 0000000000..ab818f399b
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13819.stderr
@@ -0,0 +1,18 @@
+
+T13819.hs:12:10: error:
+    • Couldn't match type ‘w0 -> A w0’ with ‘A a’
+      Expected type: a -> A a
+        Actual type: (w1 -> WrappedMonad A w2) (w0 -> A w0)
+    • In the expression: pure @(_ -> WrappedMonad A _) @(_ -> A _) pure
+      In an equation for ‘pure’:
+          pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure
+      In the instance declaration for ‘Applicative A’
+    • Relevant bindings include
+        pure :: a -> A a (bound at T13819.hs:12:3)
+
+T13819.hs:12:17: error:
+    • Expected kind ‘* -> *’, but ‘_ -> WrappedMonad A _’ has kind ‘*’
+    • In the type ‘(_ -> WrappedMonad A _)’
+      In the expression: pure @(_ -> WrappedMonad A _) @(_ -> A _) pure
+      In an equation for ‘pure’:
+          pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure
diff --git a/testsuite/tests/typecheck/should_fail/T14000.hs b/testsuite/tests/typecheck/should_fail/T14000.hs
new file mode 100644
index 0000000000..854a78b6ad
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14000.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeFamilies #-}
+module T14000 where
+
+class C a where
+    type T a
+    c :: a -> T a
+
+foo = c noSuchThing   -- noSuchThing is not in scope
diff --git a/testsuite/tests/typecheck/should_fail/T14000.stderr b/testsuite/tests/typecheck/should_fail/T14000.stderr
new file mode 100644
index 0000000000..8b51e37641
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14000.stderr
@@ -0,0 +1,2 @@
+
+T14000.hs:8:9: error: Variable not in scope: noSuchThing
diff --git a/testsuite/tests/typecheck/should_fail/T14055.hs b/testsuite/tests/typecheck/should_fail/T14055.hs
new file mode 100644
index 0000000000..996c33be1c
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14055.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE DataKinds, TypeFamilies #-}
+
+newtype X = RollX (() -> X)
+
+type family F t :: X where
+    F t = RollX (t -> ())
diff --git a/testsuite/tests/typecheck/should_fail/T14055.stderr b/testsuite/tests/typecheck/should_fail/T14055.stderr
new file mode 100644
index 0000000000..19e4d59112
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T14055.stderr
@@ -0,0 +1,6 @@
+
+T14055.hs:6:18: error:
+    • Expected kind ‘() -> X’, but ‘t -> ()’ has kind ‘*’
+    • In the first argument of ‘RollX’, namely ‘(t -> ())’
+      In the type ‘RollX (t -> ())’
+      In the type family declaration for ‘F’
diff --git a/testsuite/tests/typecheck/should_fail/T2994.stderr b/testsuite/tests/typecheck/should_fail/T2994.stderr
index 4777e486e6..7f20acf5aa 100644
--- a/testsuite/tests/typecheck/should_fail/T2994.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2994.stderr
@@ -18,7 +18,6 @@ T2994.hs:13:23: error:
       In the instance declaration for ‘MonadReader (Reader' r)’
 
 T2994.hs:15:10: error:
-    • Expecting one fewer arguments to ‘MonadReader r r’
-      Expected kind ‘(* -> *) -> Constraint’,
+    • Expected kind ‘(* -> *) -> Constraint’,
         but ‘MonadReader r r’ has kind ‘Constraint’
     • In the instance declaration for ‘MonadReader r r (Reader' r)’
diff --git a/testsuite/tests/typecheck/should_fail/T3540.stderr b/testsuite/tests/typecheck/should_fail/T3540.stderr
index 1723e86bbe..0fdb88b313 100644
--- a/testsuite/tests/typecheck/should_fail/T3540.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3540.stderr
@@ -12,7 +12,7 @@ T3540.hs:10:13: error:
     • In the type signature: thing2 :: (a ~ Int) -> Int
 
 T3540.hs:13:12: error:
-    • Expected a type, but ‘?dude::Int’ has kind ‘Constraint’
+    • Expected a type, but ‘?dude :: Int’ has kind ‘Constraint’
     • In the type signature: thing3 :: (?dude :: Int) -> Int
 
 T3540.hs:16:11: error:
diff --git a/testsuite/tests/typecheck/should_fail/T4875.stderr b/testsuite/tests/typecheck/should_fail/T4875.stderr
index 782b0969d5..48808e319c 100644
--- a/testsuite/tests/typecheck/should_fail/T4875.stderr
+++ b/testsuite/tests/typecheck/should_fail/T4875.stderr
@@ -1,7 +1,5 @@
 
 T4875.hs:27:24: error:
-    • Expecting one fewer arguments to ‘r’
-      Expected kind ‘* -> *’, but ‘r’ has kind ‘*’
-    • In the type signature:
-        multiplicities :: r c -> [c]
+    • Expected kind ‘* -> *’, but ‘r’ has kind ‘*’
+    • In the type signature: multiplicities :: r c -> [c]
       In the class declaration for ‘Morphic’
diff --git a/testsuite/tests/typecheck/should_fail/T5691.stderr b/testsuite/tests/typecheck/should_fail/T5691.stderr
index ad5c7e452f..9d4e587166 100644
--- a/testsuite/tests/typecheck/should_fail/T5691.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5691.stderr
@@ -1,12 +1,12 @@
 
-T5691.hs:14:9: error:
+T5691.hs:15:24: error:
     • Couldn't match type ‘p’ with ‘PrintRuleInterp’
       Expected type: PrintRuleInterp a
         Actual type: p a
-    • When checking that the pattern signature: p a
-        fits the type of its context: PrintRuleInterp a
-      In the pattern: f :: p a
-      In an equation for ‘test’: test (f :: p a) = MkPRI $ printRule_ f
+    • In the first argument of ‘printRule_’, namely ‘f’
+      In the second argument of ‘($)’, namely ‘printRule_ f’
+      In the expression: MkPRI $ printRule_ f
+    • Relevant bindings include f :: p a (bound at T5691.hs:14:9)
 
 T5691.hs:24:10: error:
     • No instance for (Alternative RecDecParser)
diff --git a/testsuite/tests/typecheck/should_fail/T7368.stderr b/testsuite/tests/typecheck/should_fail/T7368.stderr
index f187aee61c..660ef98f26 100644
--- a/testsuite/tests/typecheck/should_fail/T7368.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368.stderr
@@ -1,7 +1,11 @@
 
 T7368.hs:3:10: error:
     • Couldn't match kind ‘*’ with ‘* -> *’
-      When matching the kind of ‘Maybe’
+      When matching types
+        b0 :: *
+        Maybe :: * -> *
+      Expected type: a0 -> b0
+        Actual type: c0 Maybe
     • In the first argument of ‘b’, namely ‘(l Nothing)’
       In the expression: b (l Nothing)
       In an equation for ‘f’: f = b (l Nothing)
diff --git a/testsuite/tests/typecheck/should_fail/T7368a.stderr b/testsuite/tests/typecheck/should_fail/T7368a.stderr
index e55aab0e62..16c8326afe 100644
--- a/testsuite/tests/typecheck/should_fail/T7368a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7368a.stderr
@@ -5,7 +5,7 @@ T7368a.hs:8:6: error:
         f :: * -> *
         Bad :: (* -> *) -> *
       Expected type: f (Bad f)
-        Actual type: Bad (Bad f)
+        Actual type: Bad w0
     • In the pattern: Bad x
       In an equation for ‘fun’: fun (Bad x) = True
     • Relevant bindings include
diff --git a/testsuite/tests/typecheck/should_fail/T7453.stderr b/testsuite/tests/typecheck/should_fail/T7453.stderr
index 518d6fad05..77348c357a 100644
--- a/testsuite/tests/typecheck/should_fail/T7453.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7453.stderr
@@ -1,56 +1,32 @@
 
-T7453.hs:9:15: error:
-    • Couldn't match type ‘p’ with ‘t’
+T7453.hs:10:30: error:
+    • Couldn't match expected type ‘t’ with actual type ‘p’
         because type variable ‘t’ would escape its scope
       This (rigid, skolem) type variable is bound by
         the type signature for:
           z :: forall t. Id t
         at T7453.hs:8:11-19
-      Expected type: Id t
-        Actual type: Id p
-    • In the expression: aux
-      In an equation for ‘z’:
-          z = aux
-            where
-                aux = Id v
-      In an equation for ‘cast1’:
-          cast1 v
-            = runId z
-            where
-                z :: Id t
-                z = aux
-                  where
-                      aux = Id v
+    • In the first argument of ‘Id’, namely ‘v’
+      In the expression: Id v
+      In an equation for ‘aux’: aux = Id v
     • Relevant bindings include
-        aux :: Id p (bound at T7453.hs:10:21)
+        aux :: Id t (bound at T7453.hs:10:21)
         z :: Id t (bound at T7453.hs:9:11)
         v :: p (bound at T7453.hs:7:7)
         cast1 :: p -> a (bound at T7453.hs:7:1)
 
-T7453.hs:15:15: error:
-    • Couldn't match type ‘p’ with ‘t1’
+T7453.hs:16:33: error:
+    • Couldn't match expected type ‘t1’ with actual type ‘p’
         because type variable ‘t1’ would escape its scope
       This (rigid, skolem) type variable is bound by
         the type signature for:
           z :: forall t1. () -> t1
         at T7453.hs:14:11-22
-      Expected type: () -> t1
-        Actual type: () -> p
-    • In the expression: aux
-      In an equation for ‘z’:
-          z = aux
-            where
-                aux = const v
-      In an equation for ‘cast2’:
-          cast2 v
-            = z ()
-            where
-                z :: () -> t
-                z = aux
-                  where
-                      aux = const v
+    • In the first argument of ‘const’, namely ‘v’
+      In the expression: const v
+      In an equation for ‘aux’: aux = const v
     • Relevant bindings include
-        aux :: forall b. b -> p (bound at T7453.hs:16:21)
+        aux :: b -> t1 (bound at T7453.hs:16:21)
         z :: () -> t1 (bound at T7453.hs:15:11)
         v :: p (bound at T7453.hs:13:7)
         cast2 :: p -> t (bound at T7453.hs:13:1)
diff --git a/testsuite/tests/typecheck/should_fail/T7609.stderr b/testsuite/tests/typecheck/should_fail/T7609.stderr
index 24339311b8..32bc980fe9 100644
--- a/testsuite/tests/typecheck/should_fail/T7609.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7609.stderr
@@ -2,16 +2,13 @@
 T7609.hs:7:16: error:
     • Expecting one more argument to ‘Maybe’
       Expected a type, but ‘Maybe’ has kind ‘* -> *’
-    • In the type signature:
-        f :: (a `X` a, Maybe)
+    • In the type signature: f :: (a `X` a, Maybe)
 
 T7609.hs:10:7: error:
-    • Expected a constraint, but ‘X a a’ has kind ‘*’
-    • In the type signature:
-        g :: (a `X` a) => Maybe
+    • Expected a constraint, but ‘a `X` a’ has kind ‘*’
+    • In the type signature: g :: (a `X` a) => Maybe
 
 T7609.hs:10:19: error:
     • Expecting one more argument to ‘Maybe’
       Expected a type, but ‘Maybe’ has kind ‘* -> *’
-    • In the type signature:
-        g :: (a `X` a) => Maybe
+    • In the type signature: g :: (a `X` a) => Maybe
diff --git a/testsuite/tests/typecheck/should_fail/T7696.stderr b/testsuite/tests/typecheck/should_fail/T7696.stderr
index eef19a5cfc..41f2296797 100644
--- a/testsuite/tests/typecheck/should_fail/T7696.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7696.stderr
@@ -1,7 +1,7 @@
 
 T7696.hs:7:6: error:
-    • Couldn't match type ‘() a0’ with ‘()’
+    • Couldn't match type ‘m0 a0’ with ‘()’
       Expected type: ((), w ())
-        Actual type: (() a0, w ())
+        Actual type: (m0 a0, t0 m0)
     • In the expression: f1
       In an equation for ‘f2’: f2 = f1
diff --git a/testsuite/tests/typecheck/should_fail/T7778.stderr b/testsuite/tests/typecheck/should_fail/T7778.stderr
index 2db22e95ff..a0f10fcd92 100644
--- a/testsuite/tests/typecheck/should_fail/T7778.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7778.stderr
@@ -1,12 +1,10 @@
 
 T7778.hs:3:7: error:
-    • Expecting one fewer arguments to ‘Num Int => Num’
-      Expected kind ‘* -> Constraint’, but ‘Num Int => Num’ has kind ‘*’
-    • In the type signature:
-        v :: ((Num Int => Num) ()) => ()
+    • Expected kind ‘* -> Constraint’,
+        but ‘Num Int => Num’ has kind ‘*’
+    • In the type signature: v :: ((Num Int => Num) ()) => ()
 
 T7778.hs:3:19: error:
     • Expecting one more argument to ‘Num’
       Expected a type, but ‘Num’ has kind ‘* -> Constraint’
-    • In the type signature:
-        v :: ((Num Int => Num) ()) => ()
+    • In the type signature: v :: ((Num Int => Num) ()) => ()
diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr
index aec8b3b55c..25d60d1aff 100644
--- a/testsuite/tests/typecheck/should_fail/T8142.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8142.stderr
@@ -1,16 +1,24 @@
 
-T8142.hs:6:18: error:
-    • Couldn't match type ‘Nu g0’ with ‘Nu g’
-      Expected type: Nu ((,) a) -> Nu g
+T8142.hs:6:10: error:
+    • Couldn't match type ‘Nu ((,) a0)’ with ‘c -> f c’
+      Expected type: (c -> f c) -> c -> f c
         Actual type: Nu ((,) a0) -> Nu g0
-      NB: ‘Nu’ is a type function, and may not be injective
-      The type variable ‘g0’ is ambiguous
-    • In the ambiguity check for the inferred type for ‘h’
-      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
-      When checking the inferred type
-        h :: forall a (g :: * -> *). Nu ((,) a) -> Nu g
+      The type variable ‘a0’ is ambiguous
+    • In the expression: h
       In an equation for ‘tracer’:
           tracer
             = h
             where
                 h = (\ (_, b) -> ((outI . fmap h) b)) . out
+    • Relevant bindings include
+        tracer :: (c -> f c) -> c -> f c (bound at T8142.hs:6:1)
+
+T8142.hs:6:57: error:
+    • Couldn't match type ‘Nu ((,) a)’ with ‘g (Nu ((,) a))’
+      Expected type: Nu ((,) a) -> (a, g (Nu ((,) a)))
+        Actual type: Nu ((,) a) -> (a, Nu ((,) a))
+    • In the second argument of ‘(.)’, namely ‘out’
+      In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
+      In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out
+    • Relevant bindings include
+        h :: Nu ((,) a) -> Nu g (bound at T8142.hs:6:18)
diff --git a/testsuite/tests/typecheck/should_fail/T8262.stderr b/testsuite/tests/typecheck/should_fail/T8262.stderr
index d52ee31a31..fb0d17aef5 100644
--- a/testsuite/tests/typecheck/should_fail/T8262.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8262.stderr
@@ -1,7 +1,11 @@
 
 T8262.hs:5:15: error:
     • Couldn't match a lifted type with an unlifted type
-      When matching the kind of ‘GHC.Prim.Int#’
+      When matching types
+        a :: *
+        GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep
     • In the first argument of ‘Just’, namely ‘(1#)’
       In the expression: Just (1#)
       In an equation for ‘foo’: foo x = Just (1#)
+    • Relevant bindings include
+        foo :: p -> Maybe a (bound at T8262.hs:5:1)
diff --git a/testsuite/tests/typecheck/should_fail/T8603.hs b/testsuite/tests/typecheck/should_fail/T8603.hs
index 90c1db3ad6..d17f246209 100644
--- a/testsuite/tests/typecheck/should_fail/T8603.hs
+++ b/testsuite/tests/typecheck/should_fail/T8603.hs
@@ -10,6 +10,10 @@ newtype RV a = RV { getPDF :: [(Rational,a)] } deriving (Show, Eq)
 instance Functor RV where
   fmap f = RV . map (\(x,y) -> (x, f y)) . getPDF
 
+instance Applicative RV where
+  pure = return
+  (<*>) = ap
+
 instance Monad RV where
   return x = RV [(1,x)]
   rv >>= f = RV $
@@ -29,4 +33,4 @@ testRVState1
   = do prize <- lift uniform [1,2,3]
        return False
 
--- lift :: (MonadTrans t, Monad m) => m a -> t m a
-\ No newline at end of file
+-- lift :: (MonadTrans t, Monad m) => m a -> t m a
diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr
index d87bd635c4..2ee5ad4634 100644
--- a/testsuite/tests/typecheck/should_fail/T8603.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8603.stderr
@@ -1,19 +1,15 @@
 
-T8603.hs:13:10: error:
-    • No instance for (Applicative RV)
-        arising from the superclasses of an instance declaration
-    • In the instance declaration for ‘Monad RV’
-
-T8603.hs:29:17: error:
-    • Couldn't match type ‘RV a1’ with ‘StateT s RV a0’
+T8603.hs:33:17: error:
+    • Couldn't match kind ‘* -> *’ with ‘*’
+      When matching types
+        t0 :: (* -> *) -> * -> *
+        (->) :: * -> * -> *
       Expected type: [Integer] -> StateT s RV a0
-        Actual type: (->) ((->) [a1]) (RV a1)
+        Actual type: t0 ((->) [a1]) (RV a1)
     • The function ‘lift’ is applied to two arguments,
-      but its type ‘([a1] -> RV a1) -> (->) ((->) [a1]) (RV a1)’
+      but its type ‘([a1] -> RV a1) -> t0 ((->) [a1]) (RV a1)’
       has only one
       In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3]
       In the expression:
         do prize <- lift uniform [1, 2, ....]
            return False
-    • Relevant bindings include
-        testRVState1 :: RVState s Bool (bound at T8603.hs:28:1)
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 254e04b55d..d865c76718 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -446,3 +446,11 @@ test('T13677', normal, compile_fail, [''])
 test('T13821A', expect_broken(13821), run_command, ['$MAKE -s --no-print-directory T13821A'])
 test('T13821B', expect_broken(13821), backpack_typecheck_fail, [''])
 test('T13983', normal, compile_fail, [''])
+test('T13530', normal, compile_fail, [''])
+test('T12373', normal, compile_fail, [''])
+test('T13610', normal, compile_fail, [''])
+test('T11672', normal, compile_fail, [''])
+test('T13819', normal, compile_fail, [''])
+test('T11963', normal, compile_fail, [''])
+test('T14000', normal, compile_fail, [''])
+test('T14055', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail070.stderr b/testsuite/tests/typecheck/should_fail/tcfail070.stderr
index 0219626375..3f7bc90d8a 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail070.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail070.stderr
@@ -1,6 +1,5 @@
 
 tcfail070.hs:15:15: error:
-    • Expecting one fewer arguments to ‘[Int]’
-      Expected kind ‘* -> k0’, but ‘[Int]’ has kind ‘*’
+    • Expected kind ‘* -> k0’, but ‘[Int]’ has kind ‘*’
     • In the type ‘([Int] Bool)’
       In the type declaration for ‘State’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail078.stderr b/testsuite/tests/typecheck/should_fail/tcfail078.stderr
index 8a94f7c4e4..014d589bf6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail078.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail078.stderr
@@ -1,6 +1,4 @@
 
 tcfail078.hs:5:6: error:
-    • Expecting one fewer arguments to ‘Integer’
-      Expected kind ‘* -> Constraint’, but ‘Integer’ has kind ‘*’
-    • In the type signature:
-        f :: Integer i => i
+    • Expected kind ‘* -> Constraint’, but ‘Integer’ has kind ‘*’
+    • In the type signature: f :: Integer i => i
diff --git a/testsuite/tests/typecheck/should_fail/tcfail090.stderr b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
index 662d7da804..efb81e8ee6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail090.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail090.stderr
@@ -1,6 +1,8 @@
 
 tcfail090.hs:11:9: error:
     • Couldn't match a lifted type with an unlifted type
-      When matching the kind of ‘ByteArray#’
+      When matching types
+        a0 :: *
+        ByteArray# :: TYPE 'UnliftedRep
     • In the expression: my_undefined
       In an equation for ‘die’: die _ = my_undefined
diff --git a/testsuite/tests/typecheck/should_fail/tcfail113.stderr b/testsuite/tests/typecheck/should_fail/tcfail113.stderr
index 410ce3daac..fbdffa5ab9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail113.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail113.stderr
@@ -2,17 +2,13 @@
 tcfail113.hs:12:7: error:
     • Expecting one more argument to ‘Maybe’
       Expected a type, but ‘Maybe’ has kind ‘* -> *’
-    • In the type signature:
-        f :: [Maybe]
+    • In the type signature: f :: [Maybe]
 
 tcfail113.hs:15:8: error:
     • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
     • In the first argument of ‘T’, namely ‘Int’
-      In the type signature:
-        g :: T Int
+      In the type signature: g :: T Int
 
 tcfail113.hs:18:6: error:
-    • Expecting one fewer arguments to ‘Int’
-      Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
-    • In the type signature:
-        h :: Int Int
+    • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’
+    • In the type signature: h :: Int Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.stderr b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
index a6fbc86c49..29a1576ddb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail122.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail122.stderr
@@ -1,7 +1,11 @@
 
 tcfail122.hs:8:9: error:
-    • Couldn't match kind ‘*’ with ‘* -> *’
-      When matching the kind of ‘a’
+    • Couldn't match kind ‘* -> *’ with ‘*’
+      When matching types
+        c0 :: (* -> *) -> *
+        a :: * -> *
+      Expected type: a b
+        Actual type: c0 d0
     • In the expression:
           undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d
       In the expression:
diff --git a/testsuite/tests/typecheck/should_fail/tcfail123.stderr b/testsuite/tests/typecheck/should_fail/tcfail123.stderr
index 8f5f0a0afe..7089810e7c 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail123.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail123.stderr
@@ -1,7 +1,9 @@
 
 tcfail123.hs:11:9: error:
     • Couldn't match a lifted type with an unlifted type
-      When matching the kind of ‘GHC.Prim.Int#’
+      When matching types
+        p0 :: *
+        GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep
     • In the first argument of ‘f’, namely ‘3#’
       In the expression: f 3#
       In an equation for ‘h’: h v = f 3#
diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
index 3f8f226468..2e0a13c844 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr
@@ -1,7 +1,6 @@
 
 tcfail132.hs:17:37: error:
-    • Expecting one fewer arguments to ‘Object f' f t’
-      Expected kind ‘* -> * -> * -> *’,
+    • Expected kind ‘* -> * -> * -> *’,
         but ‘Object f' f t’ has kind ‘* -> * -> *’
     • In the first argument of ‘T’, namely ‘(Object f' f t)’
       In the type ‘T (Object f' f t) (DUnit t)’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail200.stderr b/testsuite/tests/typecheck/should_fail/tcfail200.stderr
index 407265ee9d..fdd0e3c073 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail200.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail200.stderr
@@ -1,7 +1,11 @@
 
 tcfail200.hs:5:15: error:
     • Couldn't match a lifted type with an unlifted type
-      When matching the kind of ‘GHC.Prim.Int#’
+      When matching types
+        a1 :: *
+        GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep
     • In the expression: 1#
       In the expression: (1#, 'c')
       In an equation for ‘x’: x = (1#, 'c')
+    • Relevant bindings include
+        x :: (a1, Char) (bound at tcfail200.hs:5:9)
diff --git a/testsuite/tests/typecheck/should_run/IPLocation.hs b/testsuite/tests/typecheck/should_run/IPLocation.hs
index 75575e0d16..964728934e 100644
--- a/testsuite/tests/typecheck/should_run/IPLocation.hs
+++ b/testsuite/tests/typecheck/should_run/IPLocation.hs
@@ -29,9 +29,15 @@ f6 0 = putStrLn $ prettyCallStack ?loc
 f6 n = f6 (n-1)
        -- recursive functions add a SrcLoc for each recursive call
 
+f7 :: IO ()
+f7 = putStrLn (prettyCallStack $ id (\_ -> callStack) ())
+       -- shouldn't crash. See #14043.
+
+main :: IO ()
 main = do f0
           f1
           f3 (\ () -> putStrLn $ prettyCallStack ?loc)
           f4 (\ () -> putStrLn $ prettyCallStack ?loc)
           f5 (\ () -> putStrLn $ prettyCallStack ?loc3)
           f6 5
+          f7
diff --git a/testsuite/tests/unboxedsums/T14051.hs b/testsuite/tests/unboxedsums/T14051.hs
new file mode 100644
index 0000000000..96662a946e
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T14051.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE UnboxedSums #-}
+
+module Main where
+
+import T14051a
+
+main :: IO ()
+main = print $ case func () of
+  (# True | #) -> 123
+  _ -> 321
diff --git a/testsuite/tests/unboxedsums/T14051a.hs b/testsuite/tests/unboxedsums/T14051a.hs
new file mode 100644
index 0000000000..b88f70ea05
--- /dev/null
+++ b/testsuite/tests/unboxedsums/T14051a.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE UnboxedSums #-}
+
+module T14051a where
+
+func :: s -> (# Bool | Bool #)
+func _ = (# True | #)
diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T
index eea818b6f1..45723cb4f0 100644
--- a/testsuite/tests/unboxedsums/all.T
+++ b/testsuite/tests/unboxedsums/all.T
@@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script'])
 #      ['$MAKE -s --no-print-directory sum_api_annots'])
 
 test('UbxSumLevPoly', normal, compile, [''])
+test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0'])
diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk
index 6250484017..eeae8a715b 100644
--- a/utils/ghc-cabal/ghc.mk
+++ b/utils/ghc-cabal/ghc.mk
@@ -27,9 +27,9 @@ CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)"
 # `cabal_macros_boot.h` also for GHC >= 8 (in which case it becomes a
 # dummy include that doesn't contribute any macro definitions).
 ifeq "$(Windows_Host)" "YES"
-CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory Win32
+CABAL_BUILD_DEPS := ghc-prim base array transformers time containers bytestring deepseq process pretty directory Win32
 else
-CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory unix
+CABAL_BUILD_DEPS := ghc-prim base array transformers time containers bytestring deepseq process pretty directory unix
 endif
 
 ghc-cabal_DIST_BINARY_NAME = ghc-cabal$(exeext0)
@@ -40,11 +40,23 @@ ifneq "$(BINDIST)" "YES"
 $(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/.
 	"$(CP)" $< $@
 
+# Minor hack, since we can't reuse the `hs-suffix-rules-srcdir` macro
+ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x),)
+# Lexer.x exists so we have to call Alex ourselves
+CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Parsec/Lexer.hs
+
+bootstrapping/Cabal/Distribution/Parsec/Lexer.hs: libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x
+	mkdir -p bootstrapping/Cabal/Distribution/Parsec
+	$(call cmd,ALEX) $< -o $@
+else
+CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Parsec/Lexer.hs
+endif
+
 $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs)
 $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs)
 $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs)
 
-$(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/.
+$(ghc-cabal_DIST_BINARY): $(CABAL_LEXER_DEP) utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/.
 	"$(GHC)" $(SRC_HC_OPTS) \
 	       $(addprefix -optc, $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE0)) \
 	       $(addprefix -optl, $(SRC_LD_OPTS) $(CONF_GCC_LINKER_OPTS_STAGE0)) \
@@ -54,14 +66,21 @@ $(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. b
 	       -no-user-$(GHC_PACKAGE_DB_FLAG) \
 	       -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \
 	       -DCABAL_VERSION=$(CABAL_VERSION) \
+	       -DCABAL_PARSEC \
 	       -DBOOTSTRAPPING \
 	       -optP-include -optPutils/ghc-cabal/cabal_macros_boot.h \
 	       -odir  bootstrapping \
 	       -hidir bootstrapping \
+	       $(CABAL_LEXER_DEP) \
 	       -ilibraries/Cabal/Cabal \
 	       -ilibraries/binary/src \
 	       -ilibraries/filepath \
 	       -ilibraries/hpc \
+	       -ilibraries/mtl \
+	       -ilibraries/text \
+	       libraries/text/cbits/cbits.c \
+	       -Ilibraries/text/include \
+	       -ilibraries/parsec \
 	       $(utils/ghc-cabal_dist_EXTRA_HC_OPTS) \
 	       $(EXTRA_HC_OPTS)
 	"$(TOUCH_CMD)" $@
diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs
index c4db3ca212..f74c7514db 100644
--- a/utils/ghctags/Main.hs
+++ b/utils/ghctags/Main.hs
@@ -284,7 +284,6 @@ boundThings modname lbinding =
     PatBind { pat_lhs = lhs } -> patThings lhs []
     VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)]
     AbsBinds { }    -> [] -- nothing interesting in a type abstraction
-    AbsBindsSig { } -> []
     PatSynBind PSB{ psb_id = id } -> [thing id]
   where thing = foundOfLName modname
         patThings lpat tl =
diff --git a/validate b/validate
index 09f4fd2f23..d885bd76ba 100755
--- a/validate
+++ b/validate
@@ -296,6 +296,7 @@ rm -f testsuite_summary.txt testsuite_summary_stage1.txt
 $make -C testsuite/tests $BINDIST $PYTHON_ARG \
       $MAKE_TEST_TARGET stage=2 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
       NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../testsuite_summary.txt \
+      JUNIT_FILE=../../testsuite.xml \
       2>&1 | tee testlog
 
 # Run a few tests using the stage1 compiler.
@@ -304,6 +305,7 @@ $make -C testsuite/tests $BINDIST $PYTHON_ARG \
 $make -C testsuite/tests/stage1 $PYTHON_ARG \
       $MAKE_TEST_TARGET stage=1 LOCAL=0 $TEST_VERBOSITY THREADS=$threads \
       NO_PRINT_SUMMARY=YES SUMMARY_FILE=../../../testsuite_summary_stage1.txt \
+      JUNIT_FILE=../../../testsuite_stage1.xml \
       2>&1 | tee testlog-stage1
 
 echo
author	Shayan Najd <sh.najd@gmail.com>	2017-08-13 18:37:54 +0000
committer	Shayan Najd <sh.najd@gmail.com>	2017-08-13 18:37:54 +0000
commit	6752680ee9253aec991cfde4dc447479564e06e7 (patch)
tree	b4802e0583eeb0288123bfc53926ef68b124eabe
parent	1c771765295bf789d4cda228a1f87c5a2e8e42b5 (diff)
parent	c6462ab02882779d7e33f2cac00cd89a9ac192f1 (diff)
download	haskell-6752680ee9253aec991cfde4dc447479564e06e7.tar.gz