Merge remote-tracking branch 'origin/master'

57 files changed, 1174 insertions, 323 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 58c9d9eb25..176685bbf9 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -2781,4 +2781,5 @@ pretendNameIsInScope n
     , liftedDataConKey, unliftedDataConKey
     , tYPETyConKey
     , runtimeRepTyConKey, boxedRepDataConKey
-    , eqTyConKey ]
+    , eqTyConKey
+    , listTyConKey ]
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 54354fcd5f..e566dea938 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -18,7 +18,7 @@ module GHC.Builtin.Types (
         mkWiredInIdName,    -- used in GHC.Types.Id.Make
 
         -- * All wired in things
-        wiredInTyCons, isBuiltInOcc_maybe,
+        wiredInTyCons, isBuiltInOcc_maybe, isPunOcc_maybe,
 
         -- * Bool
         boolTy, boolTyCon, boolTyCon_RDR, boolTyConName,
@@ -372,7 +372,7 @@ falseDataConName  = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") fa
 trueDataConName   = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True")  trueDataConKey  trueDataCon
 
 listTyConName, nilDataConName, consDataConName :: Name
-listTyConName     = mkWiredInTyConName   BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon
+listTyConName     = mkWiredInTyConName   UserSyntax    gHC_TYPES (fsLit "List") listTyConKey listTyCon
 nilDataConName    = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit "[]") nilDataConKey nilDataCon
 consDataConName   = mkWiredInDataConName BuiltInSyntax gHC_TYPES (fsLit ":") consDataConKey consDataCon
 
@@ -931,6 +931,21 @@ isBuiltInOcc_maybe occ =
       = choose_ns (getName (tupleTyCon   boxity arity))
                   (getName (tupleDataCon boxity arity))
 
+-- When resolving names produced by Template Haskell (see thOrigRdrName
+-- in GHC.ThToHs), we want ghc-prim:GHC.Types.List to yield an Exact name, not
+-- an Orig name.
+--
+-- This matters for pretty-printing under ListTuplePuns. If we don't do it,
+-- then -ddump-splices will print ''[] as ''GHC.Types.List.
+--
+-- Test case: th/T13776
+--
+isPunOcc_maybe :: Module -> OccName -> Maybe Name
+isPunOcc_maybe mod occ
+  | mod == gHC_TYPES, occ == occName listTyConName
+  = Just listTyConName
+isPunOcc_maybe _ _ = Nothing
+
 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 -- No need to cache these, the caching is done in mk_tuple
 mkTupleOcc ns Boxed   ar = mkOccName ns (mkBoxedTupleStr   ar)
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 45f5b3a550..4011e265e2 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -26,7 +26,7 @@ import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
 import GHC.Core.Utils   ( mkTicks, stripTicksTop, dumpIdInfoOfProgram )
 import GHC.Core.Lint    ( endPass, lintPassResult, dumpPassResult,
                           lintAnnots )
-import GHC.Core.Opt.Simplify       ( simplTopBinds, simplExpr, simplRules )
+import GHC.Core.Opt.Simplify       ( simplTopBinds, simplExpr, simplImpRules )
 import GHC.Core.Opt.Simplify.Utils ( simplEnvForGHCi, activeRule, activeUnfolding )
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Simplify.Monad
@@ -749,7 +749,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
                       -- for imported Ids.  Eg  RULE map my_f = blah
                       -- If we have a substitution my_f :-> other_f, we'd better
                       -- apply it to the rule to, or it'll never match
-                  ; rules1 <- simplRules env1 Nothing rules Nothing
+                  ; rules1 <- simplImpRules env1 rules
 
                   ; return (getTopFloatBinds floats, rules1) } ;
 
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index a5b40879b1..e6f803b512 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE TypeFamilies #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates -Wno-incomplete-uni-patterns #-}
-module GHC.Core.Opt.Simplify ( simplTopBinds, simplExpr, simplRules ) where
+module GHC.Core.Opt.Simplify ( simplTopBinds, simplExpr, simplImpRules ) where
 
 import GHC.Prelude
 
@@ -236,10 +236,11 @@ simplTopBinds env0 binds0
                                       ; return (floats1, env2) }
 
     simpl_bind env (Rec pairs)
-      = simplRecBind env TopLevel Nothing pairs
+      = simplRecBind env (BC_Let TopLevel Recursive) pairs
     simpl_bind env (NonRec b r)
-      = do { (env', b') <- addBndrRules env b (lookupRecBndr env b) Nothing
-           ; simplRecOrTopPair env' TopLevel NonRecursive Nothing b b' r }
+      = do { let bind_cxt = BC_Let TopLevel NonRecursive
+           ; (env', b') <- addBndrRules env b (lookupRecBndr env b) bind_cxt
+           ; simplRecOrTopPair env' bind_cxt b b' r }
 
 {-
 ************************************************************************
@@ -252,10 +253,10 @@ simplRecBind is used for
         * recursive bindings only
 -}
 
-simplRecBind :: SimplEnv -> TopLevelFlag -> MaybeJoinCont
+simplRecBind :: SimplEnv -> BindContext
              -> [(InId, InExpr)]
              -> SimplM (SimplFloats, SimplEnv)
-simplRecBind env0 top_lvl mb_cont pairs0
+simplRecBind env0 bind_cxt pairs0
   = do  { (env_with_info, triples) <- mapAccumLM add_rules env0 pairs0
         ; (rec_floats, env1) <- go env_with_info triples
         ; return (mkRecFloats rec_floats, env1) }
@@ -263,13 +264,13 @@ simplRecBind env0 top_lvl mb_cont pairs0
     add_rules :: SimplEnv -> (InBndr,InExpr) -> SimplM (SimplEnv, (InBndr, OutBndr, InExpr))
         -- Add the (substituted) rules to the binder
     add_rules env (bndr, rhs)
-        = do { (env', bndr') <- addBndrRules env bndr (lookupRecBndr env bndr) mb_cont
+        = do { (env', bndr') <- addBndrRules env bndr (lookupRecBndr env bndr) bind_cxt
              ; return (env', (bndr, bndr', rhs)) }
 
     go env [] = return (emptyFloats env, env)
 
     go env ((old_bndr, new_bndr, rhs) : pairs)
-        = do { (float, env1) <- simplRecOrTopPair env top_lvl Recursive mb_cont
+        = do { (float, env1) <- simplRecOrTopPair env bind_cxt
                                                   old_bndr new_bndr rhs
              ; (floats, env2) <- go env1 pairs
              ; return (float `addFloats` floats, env2) }
@@ -283,27 +284,25 @@ It assumes the binder has already been simplified, but not its IdInfo.
 -}
 
 simplRecOrTopPair :: SimplEnv
-                  -> TopLevelFlag -> RecFlag -> MaybeJoinCont
+                  -> BindContext
                   -> InId -> OutBndr -> InExpr  -- Binder and rhs
                   -> SimplM (SimplFloats, SimplEnv)
 
-simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs
-  | Just env' <- preInlineUnconditionally env top_lvl old_bndr rhs env
+simplRecOrTopPair env bind_cxt old_bndr new_bndr rhs
+  | Just env' <- preInlineUnconditionally env (bindContextLevel bind_cxt)
+                                          old_bndr rhs env
   = {-#SCC "simplRecOrTopPair-pre-inline-uncond" #-}
     simplTrace env "SimplBindr:inline-uncond" (ppr old_bndr) $
     do { tick (PreInlineUnconditionally old_bndr)
        ; return ( emptyFloats env, env' ) }
 
-  | Just cont <- mb_cont
-  = {-#SCC "simplRecOrTopPair-join" #-}
-    assert (isNotTopLevel top_lvl && isJoinId new_bndr )
-    simplTrace env "SimplBind:join" (ppr old_bndr) $
-    simplJoinBind env cont old_bndr new_bndr rhs env
-
   | otherwise
-  = {-#SCC "simplRecOrTopPair-normal" #-}
-    simplTrace env "SimplBind:normal" (ppr old_bndr) $
-    simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
+  = case bind_cxt of
+      BC_Join cont  -> simplTrace env "SimplBind:join" (ppr old_bndr) $
+                       simplJoinBind env cont old_bndr new_bndr rhs env
+
+      BC_Let top_lvl is_rec -> simplTrace env "SimplBind:normal" (ppr old_bndr) $
+                               simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
 
 simplTrace :: SimplEnv -> String -> SDoc -> a -> a
 simplTrace env herald doc thing_inside
@@ -323,6 +322,7 @@ simplLazyBind :: SimplEnv
                                         -- Ids only, no TyVars
               -> InExpr -> SimplEnv     -- The RHS and its environment
               -> SimplM (SimplFloats, SimplEnv)
+-- Precondition: the OutId is already in the InScopeSet of the incoming 'env'
 -- Precondition: not a JoinId
 -- Precondition: rhs obeys the let/app invariant
 -- NOT used for JoinIds
@@ -346,7 +346,6 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
                         --    f = /\a. \x. g a x
                         -- should eta-reduce.
 
-
         ; (body_env, tvs') <- {-#SCC "simplBinders" #-} simplBinders rhs_env tvs
                 -- See Note [Floating and type abstraction] in GHC.Core.Opt.Simplify.Utils
 
@@ -354,41 +353,32 @@ simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
         ; let rhs_cont = mkRhsStop (substTy body_env (exprType body))
         ; (body_floats0, body0) <- {-#SCC "simplExprF" #-} simplExprF body_env body rhs_cont
 
-              -- Never float join-floats out of a non-join let-binding (which this is)
-              -- So wrap the body in the join-floats right now
-              -- Hence: body_floats1 consists only of let-floats
-        ; let (body_floats1, body1) = wrapJoinFloatsX body_floats0 body0
-
         -- ANF-ise a constructor or PAP rhs
-        -- We get at most one float per argument here
-        ; let body_env1 = body_env `setInScopeFromF` body_floats1
-              -- body_env1: add to in-scope set the binders from body_floats1
-              -- so that prepareBinding knows what is in scope in body1
-        ; (let_floats, body2) <- {-#SCC "prepareBinding" #-}
-                                 prepareBinding body_env1 top_lvl bndr1 body1
-        ; let body_floats2 = body_floats1 `addLetFloats` let_floats
+        ; (body_floats2, body2) <- {-#SCC "prepareBinding" #-}
+                                   prepareBinding env top_lvl is_rec
+                                                  False  -- Not strict; this is simplLazyBind
+                                                  bndr1 body_floats0 body0
+          -- Subtle point: we do not need or want tvs' in the InScope set
+          -- of body_floats2, so we pass in 'env' not 'body_env'.
+          -- Don't want: if tvs' are in-scope in the scope of this let-binding, we may do
+          -- more renaming than necessary => extra work (see !7777 and test T16577).
+          -- Don't need: we wrap tvs' around the RHS anyway.
 
         ; (rhs_floats, body3)
-            <-  if not (doFloatFromRhs top_lvl is_rec False body_floats2 body2)
-                then -- Do not float; abandon prepareBinding entirely and revert to body1
-                     return (emptyFloats env, wrapFloats body_floats1 body1)
-
-                else if null tvs then   -- Simple floating
+            <-  if isEmptyFloats body_floats2 || null tvs then   -- Simple floating
                      {-#SCC "simplLazyBind-simple-floating" #-}
-                     do { tick LetFloatFromLet
-                        ; return (body_floats2, body2) }
+                     return (body_floats2, body2)
 
-                else                    -- Do type-abstraction first
+                else -- Non-empty floats, and non-empty tyvars: do type-abstraction first
                      {-#SCC "simplLazyBind-type-abstraction-first" #-}
-                     do { tick LetFloatFromLet
-                        ; (poly_binds, body3) <- abstractFloats (seUnfoldingOpts env) top_lvl
+                     do { (poly_binds, body3) <- abstractFloats (seUnfoldingOpts env) top_lvl
                                                                 tvs' body_floats2 body2
                         ; let floats = foldl' extendFloats (emptyFloats env) poly_binds
                         ; return (floats, body3) }
 
         ; let env' = env `setInScopeFromF` rhs_floats
         ; rhs' <- mkLam env' tvs' body3 rhs_cont
-        ; (bind_float, env2) <- completeBind env' top_lvl Nothing bndr bndr1 rhs'
+        ; (bind_float, env2) <- completeBind env' (BC_Let top_lvl is_rec) bndr bndr1 rhs'
         ; return (rhs_floats `addFloats` bind_float, env2) }
 
 --------------------------
@@ -402,7 +392,7 @@ simplJoinBind :: SimplEnv
 simplJoinBind env cont old_bndr new_bndr rhs rhs_se
   = do  { let rhs_env = rhs_se `setInScopeFromE` env
         ; rhs' <- simplJoinRhs rhs_env old_bndr rhs cont
-        ; completeBind env NotTopLevel (Just cont) old_bndr new_bndr rhs' }
+        ; completeBind env (BC_Join cont) old_bndr new_bndr rhs' }
 
 --------------------------
 simplNonRecX :: SimplEnv
@@ -430,39 +420,24 @@ simplNonRecX env bndr new_rhs
            , extendIdSubst env bndr (DoneEx new_rhs Nothing))
 
   | otherwise
-  = do  { (env', bndr') <- simplBinder env bndr
-        ; completeNonRecX NotTopLevel env' (isStrictId bndr') bndr bndr' new_rhs }
-          -- NotTopLevel: simplNonRecX is only used for NotTopLevel things
-          --
-          -- isStrictId: use bndr' because the InId bndr might not have
-          -- a fixed runtime representation, which isStrictId doesn't expect
-          -- c.f. Note [Dark corner with representation polymorphism]
+  = do  { (env1, new_bndr)   <- simplBinder env bndr
+        ; let is_strict = isStrictId new_bndr
+              -- isStrictId: use new_bndr because the InId bndr might not have
+              -- a fixed runtime representation, which isStrictId doesn't expect
+              -- c.f. Note [Dark corner with representation polymorphism]
+
+        ; (rhs_floats, rhs1) <- prepareBinding env NotTopLevel NonRecursive is_strict
+                                               new_bndr (emptyFloats env) new_rhs
+              -- NB: it makes a surprisingly big difference (5% in compiler allocation
+              -- in T9630) to pass 'env' rather than 'env1'.  It's fine to pass 'env',
+              -- because this is simplNonRecX, so bndr is not in scope in the RHS.
+
+        ; (bind_float, env2) <- completeBind (env1 `setInScopeFromF` rhs_floats)
+                                             (BC_Let NotTopLevel NonRecursive)
+                                             bndr new_bndr rhs1
+              -- Must pass env1 to completeBind in case simplBinder had to clone,
+              -- and extended the substitution with [bndr :-> new_bndr]
 
---------------------------
-completeNonRecX :: TopLevelFlag -> SimplEnv
-                -> Bool
-                -> InId                 -- Old binder; not a JoinId
-                -> OutId                -- New binder
-                -> OutExpr              -- Simplified RHS
-                -> SimplM (SimplFloats, SimplEnv)    -- The new binding is in the floats
--- Precondition: rhs satisfies the let/app invariant
---               See Note [Core let/app invariant] in GHC.Core
-
-completeNonRecX top_lvl env is_strict old_bndr new_bndr new_rhs
-  = assertPpr (not (isJoinId new_bndr)) (ppr new_bndr) $
-    do  { (prepd_floats, prepd_rhs) <- prepareBinding env top_lvl new_bndr new_rhs
-        ; let floats = emptyFloats env `addLetFloats` prepd_floats
-        ; (rhs_floats, rhs2) <-
-                if doFloatFromRhs NotTopLevel NonRecursive is_strict floats prepd_rhs
-                then    -- Add the floats to the main env
-                     do { tick LetFloatFromLet
-                        ; return (floats, prepd_rhs) }
-                else    -- Do not float; abandon prepareBinding entirely and revert to new_rhs
-                     return (emptyFloats env, new_rhs)
-
-        ; (bind_float, env2) <- completeBind (env `setInScopeFromF` rhs_floats)
-                                             NotTopLevel Nothing
-                                             old_bndr new_bndr rhs2
         ; return (rhs_floats `addFloats` bind_float, env2) }
 
 
@@ -610,13 +585,13 @@ unless the kind of the type of rhs is concrete, in the sense of
 Note [Concrete types] in GHC.Tc.Utils.Concrete.
 -}
 
-tryCastWorkerWrapper :: SimplEnv -> TopLevelFlag
+tryCastWorkerWrapper :: SimplEnv -> BindContext
                      -> InId -> OccInfo
                      -> OutId -> OutExpr
                      -> SimplM (SimplFloats, SimplEnv)
 -- See Note [Cast worker/wrapper]
-tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
-  | not (isJoinId bndr) -- Not for join points
+tryCastWorkerWrapper env bind_cxt old_bndr occ_info bndr (Cast rhs co)
+  | BC_Let top_lvl is_rec <- bind_cxt  -- Not join points
   , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform
                         --            a DFunUnfolding in mk_worker_unfolding
   , not (exprIsTrivial rhs)        -- Not x = y |> co; Wrinkle 1
@@ -626,34 +601,36 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
                                    -- See Note [Preserve RuntimeRep info in cast w/w]
   , not (isOpaquePragma (idInlinePragma old_bndr)) -- Not for OPAQUE bindings
                                                    -- See Note [OPAQUE pragma]
-  = do  { (rhs_floats, work_rhs) <- prepareRhs env top_lvl occ_fs rhs
-        ; uniq <- getUniqueM
+  = do  { uniq <- getUniqueM
         ; let work_name = mkSystemVarName uniq occ_fs
               work_id   = mkLocalIdWithInfo work_name Many rhs_ty worker_info
-
-       ; work_unf <- mk_worker_unfolding work_id work_rhs
-       ; let  work_id_w_unf = work_id `setIdUnfolding` work_unf
-              floats   = emptyFloats env
-                         `addLetFloats` rhs_floats
-                         `addLetFloats` unitLetFloat (NonRec work_id_w_unf work_rhs)
-
-              triv_rhs = Cast (Var work_id_w_unf) co
-
-       ; if postInlineUnconditionally env top_lvl bndr occ_info triv_rhs
-            -- Almost always True, because the RHS is trivial
-            -- In that case we want to eliminate the binding fast
-            -- We conservatively use postInlineUnconditionally so that we
-            -- check all the right things
-         then do { tick (PostInlineUnconditionally bndr)
-                 ; return ( floats
-                          , extendIdSubst (setInScopeFromF env floats) old_bndr $
-                            DoneEx triv_rhs Nothing ) }
-
-         else do { wrap_unf <- mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs bndr triv_rhs
-                 ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr)
-                               `setIdUnfolding`  wrap_unf
-                       floats' = floats `extendFloats` NonRec bndr' triv_rhs
-                 ; return ( floats', setInScopeFromF env floats' ) } }
+              is_strict = isStrictId bndr
+
+        ; (rhs_floats, work_rhs) <- prepareBinding env top_lvl is_rec is_strict
+                                                   work_id (emptyFloats env) rhs
+
+        ; work_unf <- mk_worker_unfolding top_lvl work_id work_rhs
+        ; let  work_id_w_unf = work_id `setIdUnfolding` work_unf
+               floats   = rhs_floats `addLetFloats`
+                          unitLetFloat (NonRec work_id_w_unf work_rhs)
+
+               triv_rhs = Cast (Var work_id_w_unf) co
+
+        ; if postInlineUnconditionally env bind_cxt bndr occ_info triv_rhs
+             -- Almost always True, because the RHS is trivial
+             -- In that case we want to eliminate the binding fast
+             -- We conservatively use postInlineUnconditionally so that we
+             -- check all the right things
+          then do { tick (PostInlineUnconditionally bndr)
+                  ; return ( floats
+                           , extendIdSubst (setInScopeFromF env floats) old_bndr $
+                             DoneEx triv_rhs Nothing ) }
+
+          else do { wrap_unf <- mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs bndr triv_rhs
+                  ; let bndr' = bndr `setInlinePragma` mkCastWrapperInlinePrag (idInlinePragma bndr)
+                                `setIdUnfolding`  wrap_unf
+                        floats' = floats `extendFloats` NonRec bndr' triv_rhs
+                  ; return ( floats', setInScopeFromF env floats' ) } }
   where
     mode   = getMode env
     occ_fs = getOccFS bndr
@@ -674,7 +651,7 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co)
     --   the next round of simplification will do the job
     -- Non-stable case: use work_rhs
     -- Wrinkle 3 of Note [Cast worker/wrapper]
-    mk_worker_unfolding work_id work_rhs
+    mk_worker_unfolding top_lvl work_id work_rhs
       = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers
            unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
              | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) })
@@ -705,11 +682,44 @@ mkCastWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info })
 *                                                                      *
 ********************************************************************* -}
 
-prepareBinding :: SimplEnv -> TopLevelFlag
-               -> OutId -> OutExpr
-               -> SimplM (LetFloats, OutExpr)
-prepareBinding env top_lvl bndr rhs
-  = prepareRhs env top_lvl (getOccFS bndr) rhs
+prepareBinding :: SimplEnv -> TopLevelFlag -> RecFlag -> Bool
+               -> Id   -- Used only for its OccName; can be InId or OutId
+               -> SimplFloats -> OutExpr
+               -> SimplM (SimplFloats, OutExpr)
+-- In (prepareBinding ... bndr floats rhs), the binding is really just
+--    bndr = let floats in rhs
+-- Maybe we can ANF-ise this binding and float out; e.g.
+--    bndr = let a = f x in K a a (g x)
+-- we could float out to give
+--    a    = f x
+--    tmp  = g x
+--    bndr = K a a tmp
+-- That's what prepareBinding does
+-- Precondition: binder is not a JoinId
+prepareBinding env top_lvl is_rec strict_bind bndr rhs_floats rhs
+  = do { -- Never float join-floats out of a non-join let-binding (which this is)
+         -- So wrap the body in the join-floats right now
+         -- Hence: rhs_floats1 consists only of let-floats
+         let (rhs_floats1, rhs1) = wrapJoinFloatsX rhs_floats rhs
+
+         -- rhs_env: add to in-scope set the binders from rhs_floats
+         -- so that prepareRhs knows what is in scope in rhs
+       ; let rhs_env = env `setInScopeFromF` rhs_floats1
+
+       -- Now ANF-ise the remaining rhs
+       ; (anf_floats, rhs2) <- prepareRhs rhs_env top_lvl (getOccFS bndr) rhs1
+
+       -- Finally, decide whether or not to float
+       ; let all_floats = rhs_floats1 `addLetFloats` anf_floats
+       ; if doFloatFromRhs top_lvl is_rec strict_bind all_floats rhs2
+         then -- Float!
+              do { tick LetFloatFromLet
+                 ; return (all_floats, rhs2) }
+
+         else -- Abandon floating altogether; revert to original rhs
+              -- Since we have already built rhs1, we just need to add
+              -- rhs_floats1 to it
+              return (emptyFloats env, wrapFloats rhs_floats1 rhs1) }
 
 {- Note [prepareRhs]
 ~~~~~~~~~~~~~~~~~~~~
@@ -892,6 +902,7 @@ It does the following:
   - tries PostInlineUnconditionally
   - add unfolding [this is the only place we add an unfolding]
   - add arity
+  - extend the InScopeSet of the SimplEnv
 
 It does *not* attempt to do let-to-case.  Why?  Because it is used for
   - top-level bindings (when let-to-case is impossible)
@@ -902,10 +913,10 @@ Nor does it do the atomic-argument thing
 -}
 
 completeBind :: SimplEnv
-             -> TopLevelFlag            -- Flag stuck into unfolding
-             -> MaybeJoinCont           -- Required only for join point
-             -> InId                    -- Old binder
-             -> OutId -> OutExpr        -- New binder and RHS
+             -> BindContext
+             -> InId           -- Old binder
+             -> OutId          -- New binder; can be a JoinId
+             -> OutExpr        -- New RHS
              -> SimplM (SimplFloats, SimplEnv)
 -- completeBind may choose to do its work
 --      * by extending the substitution (e.g. let x = y in ...)
@@ -913,7 +924,7 @@ completeBind :: SimplEnv
 --
 -- Binder /can/ be a JoinId
 -- Precondition: rhs obeys the let/app invariant
-completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs
+completeBind env bind_cxt old_bndr new_bndr new_rhs
  | isCoVar old_bndr
  = case new_rhs of
      Coercion co -> return (emptyFloats env, extendCvSubst env old_bndr co)
@@ -930,13 +941,13 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs
       ; (new_arity, eta_rhs) <- tryEtaExpandRhs env new_bndr new_rhs
 
         -- Simplify the unfolding
-      ; new_unfolding <- simplLetUnfolding env top_lvl mb_cont old_bndr
+      ; new_unfolding <- simplLetUnfolding env bind_cxt old_bndr
                          eta_rhs (idType new_bndr) new_arity old_unf
 
       ; let new_bndr_w_info = addLetBndrInfo new_bndr new_arity new_unfolding
         -- See Note [In-scope set as a substitution]
 
-      ; if postInlineUnconditionally env top_lvl new_bndr_w_info occ_info eta_rhs
+      ; if postInlineUnconditionally env bind_cxt new_bndr_w_info occ_info eta_rhs
 
         then -- Inline and discard the binding
              do  { tick (PostInlineUnconditionally old_bndr)
@@ -951,7 +962,7 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs
 
         else -- Keep the binding; do cast worker/wrapper
              -- pprTrace "Binding" (ppr new_bndr <+> ppr new_unfolding) $
-             tryCastWorkerWrapper env top_lvl old_bndr occ_info new_bndr_w_info eta_rhs }
+             tryCastWorkerWrapper env bind_cxt old_bndr occ_info new_bndr_w_info eta_rhs }
 
 addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId
 addLetBndrInfo new_bndr new_arity_type new_unf
@@ -1712,8 +1723,8 @@ simplNonRecE env bndr (rhs, rhs_se) body cont
 
        -- Deal with lazy bindings
          else do
-       { (env2, bndr2) <- addBndrRules env1 bndr bndr1 Nothing
-       ; (floats1, env3) <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
+       { (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Let NotTopLevel NonRecursive)
+       ; (floats1, env3)  <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
        ; (floats2, expr') <- simplLam env3 body cont
        ; return (floats1 `addFloats` floats2, expr') } }
 
@@ -1726,13 +1737,14 @@ simplRecE :: SimplEnv
 
 -- simplRecE is used for
 --  * non-top-level recursive lets in expressions
+-- Precondition: not a join-point binding
 simplRecE env pairs body cont
   = do  { let bndrs = map fst pairs
         ; massert (all (not . isJoinId) bndrs)
         ; env1 <- simplRecBndrs env bndrs
                 -- NB: bndrs' don't have unfoldings or rules
                 -- We add them as we go down
-        ; (floats1, env2) <- simplRecBind env1 NotTopLevel Nothing pairs
+        ; (floats1, env2)  <- simplRecBind env1 (BC_Let NotTopLevel Recursive) pairs
         ; (floats2, expr') <- simplExprF env2 body cont
         ; return (floats1 `addFloats` floats2, expr') }
 
@@ -1812,11 +1824,6 @@ is a join point, and what 'cont' is, in a value of type MaybeJoinCont
 of a SpecConstr-generated RULE for a join point.
 -}
 
-type MaybeJoinCont = Maybe SimplCont
-  -- Nothing => Not a join point
-  -- Just k  => This is a join binding with continuation k
-  -- See Note [Rules and unfolding for join points]
-
 simplNonRecJoinPoint :: SimplEnv -> InId -> InExpr
                      -> InExpr -> SimplCont
                      -> SimplM (SimplFloats, OutExpr)
@@ -1833,7 +1840,7 @@ simplNonRecJoinPoint env bndr rhs body cont
         ; let mult   = contHoleScaling cont
               res_ty = contResultType cont
         ; (env1, bndr1)    <- simplNonRecJoinBndr env bndr mult res_ty
-        ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (Just cont)
+        ; (env2, bndr2)    <- addBndrRules env1 bndr bndr1 (BC_Join cont)
         ; (floats1, env3)  <- simplJoinBind env2 cont bndr bndr2 rhs env
         ; (floats2, body') <- simplExprF env3 body cont
         ; return (floats1 `addFloats` floats2, body') }
@@ -1851,7 +1858,7 @@ simplRecJoinPoint env pairs body cont
        ; env1 <- simplRecJoinBndrs env bndrs mult res_ty
                -- NB: bndrs' don't have unfoldings or rules
                -- We add them as we go down
-       ; (floats1, env2)  <- simplRecBind env1 NotTopLevel (Just cont) pairs
+       ; (floats1, env2)  <- simplRecBind env1 (BC_Join cont) pairs
        ; (floats2, body') <- simplExprF env2 body cont
        ; return (floats1 `addFloats` floats2, body') }
 
@@ -4000,20 +4007,20 @@ because we don't know its usage in each RHS separately
 ************************************************************************
 -}
 
-simplLetUnfolding :: SimplEnv-> TopLevelFlag
-                  -> MaybeJoinCont
+simplLetUnfolding :: SimplEnv
+                  -> BindContext
                   -> InId
                   -> OutExpr -> OutType -> ArityType
                   -> Unfolding -> SimplM Unfolding
-simplLetUnfolding env top_lvl cont_mb id new_rhs rhs_ty arity unf
+simplLetUnfolding env bind_cxt id new_rhs rhs_ty arity unf
   | isStableUnfolding unf
-  = simplStableUnfolding env top_lvl cont_mb id rhs_ty arity unf
+  = simplStableUnfolding env bind_cxt id rhs_ty arity unf
   | isExitJoinId id
   = return noUnfolding -- See Note [Do not inline exit join points] in GHC.Core.Opt.Exitify
   | otherwise
   = -- Otherwise, we end up retaining all the SimpleEnv
     let !opts = seUnfoldingOpts env
-    in mkLetUnfolding opts top_lvl InlineRhs id new_rhs
+    in mkLetUnfolding opts (bindContextLevel bind_cxt) InlineRhs id new_rhs
 
 -------------------
 mkLetUnfolding :: UnfoldingOpts -> TopLevelFlag -> UnfoldingSource
@@ -4034,15 +4041,14 @@ mkLetUnfolding !uf_opts top_lvl src id new_rhs
     !is_bottoming = isDeadEndId id
 
 -------------------
-simplStableUnfolding :: SimplEnv -> TopLevelFlag
-                     -> MaybeJoinCont  -- Just k => a join point with continuation k
+simplStableUnfolding :: SimplEnv -> BindContext
                      -> InId
                      -> OutType
                      -> ArityType      -- Used to eta expand, but only for non-join-points
                      -> Unfolding
                      ->SimplM Unfolding
 -- Note [Setting the new unfolding]
-simplStableUnfolding env top_lvl mb_cont id rhs_ty id_arity unf
+simplStableUnfolding env bind_cxt id rhs_ty id_arity unf
   = case unf of
       NoUnfolding   -> return unf
       BootUnfolding -> return unf
@@ -4055,11 +4061,11 @@ simplStableUnfolding env top_lvl mb_cont id rhs_ty id_arity unf
 
       CoreUnfolding { uf_tmpl = expr, uf_src = src, uf_guidance = guide }
         | isStableSource src
-        -> do { expr' <- case mb_cont of
-                           Just cont -> -- Binder is a join point
-                                        -- See Note [Rules and unfolding for join points]
-                                        simplJoinRhs unf_env id expr cont
-                           Nothing   -> -- Binder is not a join point
+        -> do { expr' <- case bind_cxt of
+                           BC_Join cont -> -- Binder is a join point
+                                           -- See Note [Rules and unfolding for join points]
+                                           simplJoinRhs unf_env id expr cont
+                           BC_Let {} -> -- Binder is not a join point
                                         do { expr' <- simplExprC unf_env expr (mkBoringStop rhs_ty)
                                            ; return (eta_expand expr') }
               ; case guide of
@@ -4101,6 +4107,7 @@ simplStableUnfolding env top_lvl mb_cont id rhs_ty id_arity unf
     uf_opts    = seUnfoldingOpts env
     -- Forcing this can save about 0.5MB of max residency and the result
     -- is small and easy to compute so might as well force it.
+    top_lvl     = bindContextLevel bind_cxt
     !is_top_lvl = isTopLevel top_lvl
     act        = idInlineActivation id
     unf_env    = updMode (updModeForStableUnfoldings act) env
@@ -4144,7 +4151,7 @@ Wrinkles
 
 * Don't eta-expand join points; see Note [Do not eta-expand join points]
   in GHC.Core.Opt.Simplify.Utils.  We uphold this because the join-point
-  case (mb_cont = Just _) doesn't use eta_expand.
+  case (bind_cxt = BC_Join _) doesn't use eta_expand.
 
 Note [Force bottoming field]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -4185,23 +4192,27 @@ See Note [Forming Rec groups] in "GHC.Core.Opt.OccurAnal"
 -}
 
 addBndrRules :: SimplEnv -> InBndr -> OutBndr
-             -> MaybeJoinCont   -- Just k for a join point binder
-                                -- Nothing otherwise
+             -> BindContext
              -> SimplM (SimplEnv, OutBndr)
 -- Rules are added back into the bin
-addBndrRules env in_id out_id mb_cont
+addBndrRules env in_id out_id bind_cxt
   | null old_rules
   = return (env, out_id)
   | otherwise
-  = do { new_rules <- simplRules env (Just out_id) old_rules mb_cont
+  = do { new_rules <- simplRules env (Just out_id) old_rules bind_cxt
        ; let final_id  = out_id `setIdSpecialisation` mkRuleInfo new_rules
        ; return (modifyInScope env final_id, final_id) }
   where
     old_rules = ruleInfoRules (idSpecialisation in_id)
 
+simplImpRules :: SimplEnv -> [CoreRule] -> SimplM [CoreRule]
+-- Simplify local rules for imported Ids
+simplImpRules env rules
+  = simplRules env Nothing rules (BC_Let TopLevel NonRecursive)
+
 simplRules :: SimplEnv -> Maybe OutId -> [CoreRule]
-           -> MaybeJoinCont -> SimplM [CoreRule]
-simplRules env mb_new_id rules mb_cont
+           -> BindContext -> SimplM [CoreRule]
+simplRules env mb_new_id rules bind_cxt
   = mapM simpl_rule rules
   where
     simpl_rule rule@(BuiltinRule {})
@@ -4212,9 +4223,9 @@ simplRules env mb_new_id rules mb_cont
                           , ru_act = act })
       = do { (env', bndrs') <- simplBinders env bndrs
            ; let rhs_ty = substTy env' (exprType rhs)
-                 rhs_cont = case mb_cont of  -- See Note [Rules and unfolding for join points]
-                                Nothing   -> mkBoringStop rhs_ty
-                                Just cont -> assertPpr join_ok bad_join_msg cont
+                 rhs_cont = case bind_cxt of  -- See Note [Rules and unfolding for join points]
+                                BC_Let {}    -> mkBoringStop rhs_ty
+                                BC_Join cont -> assertPpr join_ok bad_join_msg cont
                  lhs_env = updMode updModeForRules env'
                  rhs_env = updMode (updModeForStableUnfoldings act) env'
                            -- See Note [Simplifying the RHS of a RULE]
@@ -4248,3 +4259,4 @@ than necesary.  Allowing some inlining might, for example, eliminate
 a binding.
 -}
 
+
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index cb3e1854d5..bcfef36be2 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -29,7 +29,7 @@ module GHC.Core.Opt.Simplify.Env (
         substCo, substCoVar,
 
         -- * Floats
-        SimplFloats(..), emptyFloats, mkRecFloats,
+        SimplFloats(..), emptyFloats, isEmptyFloats, mkRecFloats,
         mkFloatBind, addLetFloats, addJoinFloats, addFloats,
         extendFloats, wrapFloats,
         doFloatFromRhs, getTopFloatBinds,
@@ -139,6 +139,13 @@ emptyFloats env
                 , sfJoinFloats = emptyJoinFloats
                 , sfInScope    = seInScope env }
 
+isEmptyFloats :: SimplFloats -> Bool
+-- Precondition: used only when sfJoinFloats is empty
+isEmptyFloats (SimplFloats { sfLetFloats  = LetFloats fs _
+                           , sfJoinFloats = js })
+  = assertPpr (isNilOL js) (ppr js ) $
+    isNilOL fs
+
 pprSimplEnv :: SimplEnv -> SDoc
 -- Used for debugging; selective
 pprSimplEnv env
@@ -485,7 +492,7 @@ andFF FltLifted  flt        = flt
 
 doFloatFromRhs :: TopLevelFlag -> RecFlag -> Bool -> SimplFloats -> OutExpr -> Bool
 -- If you change this function look also at FloatIn.noFloatFromRhs
-doFloatFromRhs lvl rec str (SimplFloats { sfLetFloats = LetFloats fs ff }) rhs
+doFloatFromRhs lvl rec strict_bind (SimplFloats { sfLetFloats = LetFloats fs ff }) rhs
   =  not (isNilOL fs) && want_to_float && can_float
   where
      want_to_float = isTopLevel lvl || exprIsCheap rhs || exprIsExpandable rhs
@@ -493,7 +500,7 @@ doFloatFromRhs lvl rec str (SimplFloats { sfLetFloats = LetFloats fs ff }) rhs
      can_float = case ff of
                    FltLifted  -> True
                    FltOkSpec  -> isNotTopLevel lvl && isNonRec rec
-                   FltCareful -> isNotTopLevel lvl && isNonRec rec && str
+                   FltCareful -> isNotTopLevel lvl && isNonRec rec && strict_bind
 
 {-
 Note [Float when cheap or expandable]
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 4ed22d2914..71468fc808 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -16,6 +16,9 @@ module GHC.Core.Opt.Simplify.Utils (
         getUnfoldingInRuleMatch,
         simplEnvForGHCi, updModeForStableUnfoldings, updModeForRules,
 
+        -- The BindContext type
+        BindContext(..), bindContextLevel,
+
         -- The continuation type
         SimplCont(..), DupFlag(..), StaticEnv,
         isSimplified, contIsStop,
@@ -82,8 +85,27 @@ import GHC.Utils.Trace
 import Control.Monad    ( when )
 import Data.List        ( sortBy )
 
-{-
-************************************************************************
+{- *********************************************************************
+*                                                                      *
+                The BindContext type
+*                                                                      *
+********************************************************************* -}
+
+-- What sort of binding is this? A let-binding or a join-binding?
+data BindContext
+  = BC_Let                 -- A regular let-binding
+      TopLevelFlag RecFlag
+
+  | BC_Join                -- A join point with continuation k
+      SimplCont            -- See Note [Rules and unfolding for join points]
+                           -- in GHC.Core.Opt.Simplify
+
+bindContextLevel :: BindContext -> TopLevelFlag
+bindContextLevel (BC_Let top_lvl _) = top_lvl
+bindContextLevel (BC_Join {})       = NotTopLevel
+
+
+{- *********************************************************************
 *                                                                      *
                 The SimplCont and DupFlag types
 *                                                                      *
@@ -1389,7 +1411,7 @@ rules] for details.
 -}
 
 postInlineUnconditionally
-    :: SimplEnv -> TopLevelFlag
+    :: SimplEnv -> BindContext
     -> OutId            -- The binder (*not* a CoVar), including its unfolding
     -> OccInfo          -- From the InId
     -> OutExpr
@@ -1398,14 +1420,15 @@ postInlineUnconditionally
 -- See Note [Core let/app invariant] in GHC.Core
 -- Reason: we don't want to inline single uses, or discard dead bindings,
 --         for unlifted, side-effect-ful bindings
-postInlineUnconditionally env top_lvl bndr occ_info rhs
+postInlineUnconditionally env bind_cxt bndr occ_info rhs
   | not active                  = False
   | isWeakLoopBreaker occ_info  = False -- If it's a loop-breaker of any kind, don't inline
                                         -- because it might be referred to "earlier"
   | isStableUnfolding unfolding = False -- Note [Stable unfoldings and postInlineUnconditionally]
-  | isTopLevel top_lvl          = False -- Note [Top level and postInlineUnconditionally]
+  | isTopLevel (bindContextLevel bind_cxt)
+                                = False -- Note [Top level and postInlineUnconditionally]
   | exprIsTrivial rhs           = True
-  | isJoinId bndr                       -- See point (1) of Note [Duplicating join points]
+  | BC_Join {} <- bind_cxt              -- See point (1) of Note [Duplicating join points]
   , not (phase == FinalPhase)   = False -- in Simplify.hs
   | otherwise
   = case occ_info of
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index bf74bac0ab..b0f5888317 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4969,6 +4969,7 @@ initSDocContext dflags style = SDC
   , sdocStarIsType                  = xopt LangExt.StarIsType dflags
   , sdocImpredicativeTypes          = xopt LangExt.ImpredicativeTypes dflags
   , sdocLinearTypes                 = xopt LangExt.LinearTypes dflags
+  , sdocListTuplePuns               = True
   , sdocPrintTypeAbbreviations      = True
   , sdocUnitIdForUser               = ftext
   }
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index ab7b344eb9..40dccb6e0e 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -1610,26 +1610,26 @@ pprIfaceCoTcApp ctxt_prec tc tys =
 -- 2. Coercions (from 'pprIfaceCoTcApp')
 ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
                  -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
-ppr_iface_tc_app pp _ tc [ty]
-  | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty)
 
-ppr_iface_tc_app pp ctxt_prec tc tys
-  | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
-  = ppr_kind_type ctxt_prec
+ppr_iface_tc_app pp ctxt_prec tc tys =
+  sdocOption sdocListTuplePuns $ \listTuplePuns ->
+  if | listTuplePuns, tc `ifaceTyConHasKey` listTyConKey, [ty] <- tys
+     -> brackets (pp topPrec ty)
 
-  | not (isSymOcc (nameOccName (ifaceTyConName tc)))
-  = pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
+     | tc `ifaceTyConHasKey` liftedTypeKindTyConKey
+     -> ppr_kind_type ctxt_prec
 
-  | [ ty1@(_, Required)
-    , ty2@(_, Required) ] <- tys
-      -- Infix, two visible arguments (we know nothing of precedence though).
-      -- Don't apply this special case if one of the arguments is invisible,
-      -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
-  = pprIfaceInfixApp ctxt_prec (ppr tc)
-                     (pp opPrec ty1) (pp opPrec ty2)
+     | not (isSymOcc (nameOccName (ifaceTyConName tc)))
+     -> pprIfacePrefixApp ctxt_prec (ppr tc) (map (pp appPrec) tys)
 
-  | otherwise
-  = pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
+     | [ ty1@(_, Required), ty2@(_, Required) ] <- tys
+         -- Infix, two visible arguments (we know nothing of precedence though).
+         -- Don't apply this special case if one of the arguments is invisible,
+         -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
+     -> pprIfaceInfixApp ctxt_prec (ppr tc) (pp opPrec ty1) (pp opPrec ty2)
+
+     | otherwise
+     -> pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
 
 -- | Pretty-print an unboxed sum type. The sum should be saturated:
 -- as many visible arguments as the arity of the sum.
diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs
index 3e83958c88..d108673e9c 100644
--- a/compiler/GHC/Parser/Errors/Ppr.hs
+++ b/compiler/GHC/Parser/Errors/Ppr.hs
@@ -300,6 +300,10 @@ instance Diagnostic PsMessage where
       -> mkSimpleDecorated $
            hang (text "Cannot parse an infix data constructor in a data/newtype declaration:") 2
                 (ppr lhs <+> ppr tc <+> ppr rhs)
+    PsErrIllegalPromotionQuoteDataCon name
+      -> mkSimpleDecorated $
+           text "Illegal promotion quote mark in the declaration of" $$
+           text "data/newtype constructor" <+> pprPrefixOcc name
     PsErrUnpackDataCon
       -> mkSimpleDecorated $ text "{-# UNPACK #-} cannot be applied to a data constructor."
     PsErrUnexpectedKindAppInDataCon lhs ki
@@ -557,6 +561,7 @@ instance Diagnostic PsMessage where
     PsErrDotsInRecordUpdate                       -> ErrorWithoutFlag
     PsErrInvalidDataCon{}                         -> ErrorWithoutFlag
     PsErrInvalidInfixDataCon{}                    -> ErrorWithoutFlag
+    PsErrIllegalPromotionQuoteDataCon{}           -> ErrorWithoutFlag
     PsErrUnpackDataCon                            -> ErrorWithoutFlag
     PsErrUnexpectedKindAppInDataCon{}             -> ErrorWithoutFlag
     PsErrInvalidRecordCon{}                       -> ErrorWithoutFlag
@@ -688,6 +693,7 @@ instance Diagnostic PsMessage where
     PsErrDotsInRecordUpdate                       -> noHints
     PsErrInvalidDataCon{}                         -> noHints
     PsErrInvalidInfixDataCon{}                    -> noHints
+    PsErrIllegalPromotionQuoteDataCon{}           -> noHints
     PsErrUnpackDataCon                            -> noHints
     PsErrUnexpectedKindAppInDataCon{}             -> noHints
     PsErrInvalidRecordCon{}                       -> noHints
diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs
index d2ff9c242d..7f40c73635 100644
--- a/compiler/GHC/Parser/Errors/Types.hs
+++ b/compiler/GHC/Parser/Errors/Types.hs
@@ -224,6 +224,9 @@ data PsMessage
    -- | Cannot parse data constructor in a data/newtype declaration
    | PsErrInvalidInfixDataCon !(HsType GhcPs) !RdrName !(HsType GhcPs)
 
+   -- | Illegal DataKinds quote mark in data/newtype constructor declaration
+   | PsErrIllegalPromotionQuoteDataCon !RdrName
+
    -- | UNPACK applied to a data constructor
    | PsErrUnpackDataCon
 
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 81082534e9..c39cc478af 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -746,8 +746,7 @@ mkGadtDecl loc names ty annsIn = do
        let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
        return (PrefixConGADT arg_types, res_type, anns, cs)
 
-  let an = case outer_bndrs of
-        _                -> EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
+  let an = EpAnn (spanAsAnchor loc) (annsIn ++ annsa) (cs Semi.<> csa)
 
   pure $ L l ConDeclGADT
                      { con_g_ext  = an
@@ -1977,9 +1976,10 @@ instance DisambTD DataConBuilder where
     addFatalError $ mkPlainErrorMsgEnvelope l_at $
                       (PsErrUnexpectedKindAppInDataCon (unLoc lhs) (unLoc ki))
 
-  mkHsOpTyPV _ lhs tc rhs = do
+  mkHsOpTyPV prom lhs tc rhs = do
       check_no_ops (unLoc rhs)  -- check the RHS because parsing type operators is right-associative
       data_con <- eitherToP $ tyConToDataCon tc
+      checkNotPromotedDataCon prom data_con
       return $ L l (InfixDataConBuilder lhs data_con rhs)
     where
       l = combineLocsA lhs rhs
@@ -2001,8 +2001,9 @@ instance DisambTD DataConBuilder where
          return constr_stuff
 
 tyToDataConBuilder :: LHsType GhcPs -> PV (LocatedA DataConBuilder)
-tyToDataConBuilder (L l (HsTyVar _ NotPromoted v)) = do
+tyToDataConBuilder (L l (HsTyVar _ prom v)) = do
   data_con <- eitherToP $ tyConToDataCon v
+  checkNotPromotedDataCon prom data_con
   return $ L l (PrefixDataConBuilder nilOL data_con)
 tyToDataConBuilder (L l (HsTupleTy _ HsBoxedOrConstraintTuple ts)) = do
   let data_con = L (l2l l) (getRdrName (tupleDataCon Boxed (length ts)))
@@ -2011,6 +2012,13 @@ tyToDataConBuilder t =
   addFatalError $ mkPlainErrorMsgEnvelope (getLocA t) $
                     (PsErrInvalidDataCon (unLoc t))
 
+-- | Rejects declarations such as @data T = 'MkT@ (note the leading tick).
+checkNotPromotedDataCon :: PromotionFlag -> LocatedN RdrName -> PV ()
+checkNotPromotedDataCon NotPromoted _ = return ()
+checkNotPromotedDataCon IsPromoted (L l name) =
+  addError $ mkPlainErrorMsgEnvelope (locA l) $
+    PsErrIllegalPromotionQuoteDataCon name
+
 {- Note [Ambiguous syntactic categories]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 There are places in the grammar where we do not know whether we are parsing an
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index 9b9eb8077b..f662495f2c 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -393,17 +393,22 @@ warnRedundantConstraints ctxt env info ev_vars
  = return ()
 
  | SigSkol user_ctxt _ _ <- info
- = restoreLclEnv env $  -- We want to add "In the type signature for f"
-                        -- to the error context, which is a bit tiresome
+ -- When dealing with a user-written type signature,
+ -- we want to add "In the type signature for f".
+ = restoreLclEnv env $
    setSrcSpan (redundantConstraintsSpan user_ctxt) $
    report_redundant_msg True
+                  --  ^^^^ add "In the type signature..."
 
- | otherwise  -- But for InstSkol there already *is* a surrounding
-              -- "In the instance declaration for Eq [a]" context
-              -- and we don't want to say it twice. Seems a bit ad-hoc
- = report_redundant_msg False
+ | otherwise
+ -- But for InstSkol there already *is* a surrounding
+ -- "In the instance declaration for Eq [a]" context
+ -- and we don't want to say it twice. Seems a bit ad-hoc
+ = restoreLclEnv env
+ $ report_redundant_msg False
+                 --   ^^^^^ don't add "In the type signature..."
  where
-   report_redundant_msg :: Bool -- whether to add "In ..." to the diagnostic
+   report_redundant_msg :: Bool -- whether to add "In the type signature..." to the diagnostic
                         -> TcRn ()
    report_redundant_msg show_info
      = do { lcl_env <- getLclEnv
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 113e89c15b..3c67bcb507 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -204,7 +204,14 @@ data TcRnMessage where
 
       Test cases: T9939, T10632, T18036a, T20602, PluralS, T19296.
   -}
-  TcRnRedundantConstraints :: [Id] -> (SkolemInfoAnon, Bool) -> TcRnMessage
+  TcRnRedundantConstraints :: [Id]
+                           -> (SkolemInfoAnon, Bool)
+                              -- ^ The contextual skolem info.
+                              -- The boolean controls whether we
+                              -- want to show it in the user message.
+                              -- (Nice to keep track of the info in either case,
+                              -- for other users of the GHC API.)
+                           -> TcRnMessage
 
   {-| TcRnInaccessibleCode is a warning that is emitted when the RHS of a pattern
       match is inaccessible, because the constraint solver has detected a contradiction.
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 75d6491bad..dada2c8041 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -536,7 +536,7 @@ The `tcRnSrcDecls` extends the environments in `gbl_env` and `lcl_env`
 which we then want to be in scope in `more stuff`.
 
 The problem is that `lcl_env :: TcLclEnv` has an IORef for error
-messages `tcl_errs`, and another for constraints (`tcl_lie`),a and
+messages `tcl_errs`, and another for constraints (`tcl_lie`), and
 another for Linear Haskell usage information (`tcl_usage`).  Now
 suppose we change it a tiny bit
    do { (gbl_env, lcl_env) <- checkNoErrs $
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 598b07b8c7..6046c60dbc 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -1621,30 +1621,30 @@ here because it uses sizeTypes, fvTypes.
 
 It checks for three things
 
-  * No repeated variables (hasNoDups fvs)
+(VD1) No repeated variables (hasNoDups fvs)
 
-  * No type constructors.  This is done by comparing
+(VD2) No type constructors.  This is done by comparing
         sizeTypes tys == length (fvTypes tys)
-    sizeTypes counts variables and constructors; fvTypes returns variables.
-    So if they are the same, there must be no constructors.  But there
-    might be applications thus (f (g x)).
-
-    Note that tys only includes the visible arguments of the class type
-    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)
-       instance Category c => Category (T c) where ...
-    since the first argument to Category is a non-visible *, which sizeTypes
-    would count as a constructor! See #11833.
-
-  * Also check for a bizarre corner case, when the derived instance decl
-    would look like
-       instance C a b => D (T a) where ...
-    Note that 'b' isn't a parameter of T.  This gives rise to all sorts of
-    problems; in particular, it's hard to compare solutions for equality
-    when finding the fixpoint, and that means the inferContext loop does
-    not converge.  See #5287.
+      sizeTypes counts variables and constructors; fvTypes returns variables.
+      So if they are the same, there must be no constructors.  But there
+      might be applications thus (f (g x)).
+
+      Note that tys only includes the visible arguments of the class type
+      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)
+         instance Category c => Category (T c) where ...
+      since the first argument to Category is a non-visible *, which sizeTypes
+      would count as a constructor! See #11833.
+
+(VD3) Also check for a bizarre corner case, when the derived instance decl
+      would look like
+         instance C a b => D (T a) where ...
+      Note that 'b' isn't a parameter of T.  This gives rise to all sorts of
+      problems; in particular, it's hard to compare solutions for equality
+      when finding the fixpoint, and that means the inferContext loop does
+      not converge.  See #5287, #21302
 
 Note [Equality class instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1657,21 +1657,27 @@ instances only in the defining module.
 validDerivPred :: TyVarSet -> PredType -> Bool
 -- See Note [Valid 'deriving' predicate]
 validDerivPred tv_set pred
+  | not (tyCoVarsOfType pred `subVarSet` tv_set)
+  = False  -- Check (VD3)
+
+  | otherwise
   = case classifyPredType pred of
-       ClassPred cls tys -> cls `hasKey` typeableClassKey
-                -- Typeable constraints are bigger than they appear due
-                -- to kind polymorphism, but that's OK
-                       || check_tys cls tys
-       EqPred {}       -> False  -- reject equality constraints
-       _               -> True   -- Non-class predicates are ok
-  where
-    check_tys cls tys
-              = hasNoDups fvs
-                   -- use sizePred to ignore implicit args
-                && lengthIs fvs (sizePred pred)
-                && all (`elemVarSet` tv_set) fvs
-      where tys' = filterOutInvisibleTypes (classTyCon cls) tys
-            fvs  = fvTypes tys'
+
+       ClassPred cls tys
+          | isTerminatingClass cls -> True
+            -- Typeable constraints are bigger than they appear due
+            -- to kind polymorphism, but that's OK
+
+          | otherwise -> hasNoDups visible_fvs                        -- Check (VD1)
+                      && lengthIs visible_fvs (sizeTypes visible_tys) -- Check (VD2)
+          where
+            visible_tys = filterOutInvisibleTypes (classTyCon cls) tys
+            visible_fvs = fvTypes visible_tys
+
+       IrredPred {}   -> True   -- Accept (f a)
+       EqPred {}      -> False  -- Reject equality constraints
+       ForAllPred {}  -> False  -- Rejects quantified predicates
+       SpecialPred {} -> False  -- Rejects special predicates
 
 {-
 ************************************************************************
@@ -2791,27 +2797,6 @@ sizeTyConAppArgs :: TyCon -> [Type] -> Int
 sizeTyConAppArgs _tc tys = sizeTypes tys -- (filterOutInvisibleTypes tc tys)
                            -- See Note [Invisible arguments and termination]
 
--- Size of a predicate
---
--- We are considering whether class constraints terminate.
--- Equality constraints and constraints for the implicit
--- parameter class always terminate so it is safe to say "size 0".
--- See #4200.
-sizePred :: PredType -> Int
-sizePred ty = goClass ty
-  where
-    goClass p = go (classifyPredType p)
-
-    go (ClassPred cls tys')
-      | isTerminatingClass cls = 0
-      | otherwise = sizeTypes (filterOutInvisibleTypes (classTyCon cls) tys')
-                    -- The filtering looks bogus
-                    -- See Note [Invisible arguments and termination]
-    go (EqPred {})           = 0
-    go (SpecialPred {})      = 0
-    go (IrredPred ty)        = sizeType ty
-    go (ForAllPred _ _ pred) = goClass pred
-
 -- | When this says "True", ignore this class constraint during
 -- a termination check
 isTerminatingClass :: Class -> Bool
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 82f30c4757..194250aff8 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -57,6 +57,7 @@ import GHC.Utils.Panic
 
 import qualified Data.ByteString as BS
 import Control.Monad( unless, ap )
+import Control.Applicative( (<|>) )
 import Data.Maybe( catMaybes, isNothing )
 import Language.Haskell.TH as TH hiding (sigP)
 import Language.Haskell.TH.Syntax as TH
@@ -2107,9 +2108,10 @@ thRdrName loc ctxt_ns th_occ th_name
 thOrigRdrName :: String -> TH.NameSpace -> PkgName -> ModName -> RdrName
 thOrigRdrName occ th_ns pkg mod =
   let occ' = mk_occ (mk_ghc_ns th_ns) occ
-  in case isBuiltInOcc_maybe occ' of
+      mod' = mkModule (mk_pkg pkg) (mk_mod mod)
+  in case isBuiltInOcc_maybe occ' <|> isPunOcc_maybe mod' occ' of
        Just name -> nameRdrName name
-       Nothing   -> (mkOrig $! (mkModule (mk_pkg pkg) (mk_mod mod))) $! occ'
+       Nothing   -> (mkOrig $! mod') $! occ'
 
 thRdrNameGuesses :: TH.Name -> [RdrName]
 thRdrNameGuesses (TH.Name occ flavour)
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index d919919e81..3d18d7bbb0 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -54,6 +54,7 @@ module GHC.Types.Name (
         setNameLoc,
         tidyNameOcc,
         localiseName,
+        namePun_maybe,
 
         nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
         pprFullName, pprTickyName,
@@ -83,6 +84,7 @@ module GHC.Types.Name (
 import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.TyThing ( TyThing )
+import {-# SOURCE #-} GHC.Builtin.Types ( listTyCon )
 
 import GHC.Platform
 import GHC.Types.Name.Occurrence
@@ -332,6 +334,12 @@ nameModule_maybe _                                  = Nothing
 is_interactive_or_from :: Module -> Module -> Bool
 is_interactive_or_from from mod = from == mod || isInteractiveModule mod
 
+-- Return the pun for a name if available.
+-- Used for pretty-printing under ListTuplePuns.
+namePun_maybe :: Name -> Maybe FastString
+namePun_maybe name | getUnique name == getUnique listTyCon = Just (fsLit "[]")
+namePun_maybe _ = Nothing
+
 nameIsLocalOrFrom :: Module -> Name -> Bool
 -- ^ Returns True if the name is
 --   (a) Internal
@@ -616,14 +624,21 @@ instance OutputableBndr Name where
     pprPrefixOcc = pprPrefixName
 
 pprName :: Name -> SDoc
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
   = getPprStyle $ \sty ->
     getPprDebug $ \debug ->
+    sdocOption sdocListTuplePuns $ \listTuplePuns ->
+    handlePuns listTuplePuns (namePun_maybe name) $
     case sort of
       WiredIn mod _ builtin   -> pprExternal debug sty uniq mod occ True  builtin
       External mod            -> pprExternal debug sty uniq mod occ False UserSyntax
       System                  -> pprSystem   debug sty uniq occ
       Internal                -> pprInternal debug sty uniq occ
+  where
+    -- Print GHC.Types.List as [], etc.
+    handlePuns :: Bool -> Maybe FastString -> SDoc -> SDoc
+    handlePuns True (Just pun) _ = ftext pun
+    handlePuns _    _          r = r
 
 -- | Print fully qualified name (with unit-id, module and unique)
 pprFullName :: Module -> Name -> SDoc
diff --git a/compiler/GHC/Types/TyThing/Ppr.hs b/compiler/GHC/Types/TyThing/Ppr.hs
index 536fb63b43..8b203aac20 100644
--- a/compiler/GHC/Types/TyThing/Ppr.hs
+++ b/compiler/GHC/Types/TyThing/Ppr.hs
@@ -33,6 +33,8 @@ import GHC.Iface.Make ( tyThingToIfaceDecl )
 import GHC.Utils.Outputable
 import GHC.Utils.Trace
 
+import Data.Maybe ( isJust )
+
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
 
@@ -178,7 +180,7 @@ pprTyThing ss ty_thing
 
     ppr_bndr :: Name -> Maybe (OccName -> SDoc)
     ppr_bndr name
-      | isBuiltInSyntax name
+      | isBuiltInSyntax name || isJust (namePun_maybe name)
          = Nothing
       | otherwise
          = case nameModule_maybe name of
diff --git a/compiler/GHC/Types/Var/Set.hs b/compiler/GHC/Types/Var/Set.hs
index e038f6c93c..9eed5e2cd2 100644
--- a/compiler/GHC/Types/Var/Set.hs
+++ b/compiler/GHC/Types/Var/Set.hs
@@ -195,7 +195,7 @@ transCloVarSet fn seeds
          new_vs = fn candidates `minusVarSet` acc
 
 seqVarSet :: VarSet -> ()
-seqVarSet s = sizeVarSet s `seq` ()
+seqVarSet s = s `seq` ()
 
 -- | Determines the pluralisation suffix appropriate for the length of a set
 -- in the same way that plural from Outputable does for lists.
@@ -323,7 +323,7 @@ delDVarSetList :: DVarSet -> [Var] -> DVarSet
 delDVarSetList = delListFromUniqDSet
 
 seqDVarSet :: DVarSet -> ()
-seqDVarSet s = sizeDVarSet s `seq` ()
+seqDVarSet s = s `seq` ()
 
 -- | Add a list of variables to DVarSet
 extendDVarSetList :: DVarSet -> [Var] -> DVarSet
diff --git a/compiler/GHC/Utils/Binary/Typeable.hs b/compiler/GHC/Utils/Binary/Typeable.hs
index 7bef358e73..5734905ebd 100644
--- a/compiler/GHC/Utils/Binary/Typeable.hs
+++ b/compiler/GHC/Utils/Binary/Typeable.hs
@@ -198,10 +198,12 @@ putTypeRep bh (App f x) = do
     put_ bh (2 :: Word8)
     putTypeRep bh f
     putTypeRep bh x
+#if __GLASGOW_HASKELL__ < 903
 putTypeRep bh (Fun arg res) = do
     put_ bh (3 :: Word8)
     putTypeRep bh arg
     putTypeRep bh res
+#endif
 
 instance Binary Serialized where
     put_ bh (Serialized the_type bytes) = do
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index f4bf62232d..782dbd45fc 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -385,6 +385,7 @@ data SDocContext = SDC
   , sdocStarIsType                  :: !Bool
   , sdocLinearTypes                 :: !Bool
   , sdocImpredicativeTypes          :: !Bool
+  , sdocListTuplePuns               :: !Bool
   , sdocPrintTypeAbbreviations      :: !Bool
   , sdocUnitIdForUser               :: !(FastString -> SDoc)
       -- ^ Used to map UnitIds to more friendly "package-version:component"
@@ -444,6 +445,7 @@ defaultSDocContext = SDC
   , sdocStarIsType                  = False
   , sdocImpredicativeTypes          = False
   , sdocLinearTypes                 = False
+  , sdocListTuplePuns               = True
   , sdocPrintTypeAbbreviations      = True
   , sdocUnitIdForUser               = ftext
   }
diff --git a/docs/users_guide/9.4.1-notes.rst b/docs/users_guide/9.4.1-notes.rst
index 91d866d982..cea17cac60 100644
--- a/docs/users_guide/9.4.1-notes.rst
+++ b/docs/users_guide/9.4.1-notes.rst
@@ -63,6 +63,9 @@ Compiler
 - New :ghc-flag:`-Wredundant-strictness-flags` that checks for strictness flags
   (``!``) applied to unlifted types, which are always strict.
 
+- New :ghc-flag:`-Wforall-identifier` (enabled by default) that warns against
+  using the name ``forall`` as an identifer on the term level.
+
 - New :ghc-flag:`-fprof-late` that adds automatic CCS annotations to all
   top level functions *after* core optimisation have been run.
 
@@ -189,13 +192,19 @@ Compiler
 ``base`` library
 ~~~~~~~~~~~~~~~~
 
-- ``GHC.Exts.magicDict`` has been renamed to ``withDict`` and given a more
-  specific type: ::
+- There's a new special function ``withDict`` in ``GHC.Exts``: ::
 
         withDict :: forall {rr :: RuntimeRep} st dt (r :: TYPE rr). st -> (dt => r) -> r
 
-  Unlike ``magicDict``, ``withDict`` can be used without defining an
-  intermediate data type. For example, the ``withTypeable`` function from the
+  where ``dt`` must be a class containing exactly one method, whose type
+  must be ``st``.
+
+  This function converts ``st`` to a type class dictionary.
+  It removes the need for ``unsafeCoerce`` in implementation of reflection
+  libraries. It should be used with care, because it can introduce
+  incoherent instances.
+
+  For example, the ``withTypeable`` function from the
   ``Data.Typeable`` module can now be defined as: ::
 
         withTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()
@@ -205,6 +214,9 @@ Compiler
   Note that the explicit type applications are required, as the call to
   ``withDict`` would be ambiguous otherwise.
 
+  This replaces the old ``GHC.Exts.magicDict``, which required
+  an intermediate data type and was less reliable.
+
 ``ghc-prim`` library
 ~~~~~~~~~~~~~~~~~~~~
 
@@ -255,7 +267,7 @@ Compiler
         ``unsafeThawSmallArray#``, ``copySmallArray#``, ``copySmallMutableArray#``, ``cloneSmallArray#``,
         ``cloneSmallMutableArray#``, ``freezeSmallArray#``, ``thawSmallArray#``, ``casSmallArray#``,
 
-    - ``newMutVar#``,``readMutVar#``,``writeMutV#``,``casMutVar#``,
+    - ``newMutVar#``, ``readMutVar#``, ``writeMutVar#``, ``casMutVar#``,
 
     - operations on ``MVar#`` and ``TVar#``:
 
@@ -284,7 +296,7 @@ Compiler
           :: forall {l :: Levity} s (a :: TYPE (BoxedRep l)).
              SmallMutableArray# s a -> Int# -> a -> State# s -> State# s
 
-- ``ArrayArray#` and ``MutableArrayArray#`` have been moved from ``GHC.Prim`` to ``GHC.Exts``.
+- ``ArrayArray#`` and ``MutableArrayArray#`` have been moved from ``GHC.Prim`` to ``GHC.Exts``.
   They are deprecated, because their functionality is now subsumed by ``Array#``
   and ``MutableArray#``.
 
diff --git a/docs/users_guide/exts/pragmas.rst b/docs/users_guide/exts/pragmas.rst
index 5aa4e9a783..6550fd88d8 100644
--- a/docs/users_guide/exts/pragmas.rst
+++ b/docs/users_guide/exts/pragmas.rst
@@ -216,7 +216,7 @@ These pragmas control the inlining of function definitions.
 
 .. pragma:: INLINE ⟨name⟩
 
-    :where: top-level
+    :where: any function definition
 
     Force GHC to inline a value.
 
@@ -308,9 +308,6 @@ selected, in which case the ``INLINE`` pragma is ignored. For example, for a
 self-recursive function, the loop breaker can only be the function
 itself, so an ``INLINE`` pragma is always ignored.
 
-Syntactically, an ``INLINE`` pragma for a function can be put anywhere
-its type signature could be put.
-
 ``INLINE`` pragmas are a particularly good idea for the
 ``then``/``return`` (or ``bind``/``unit``) functions in a monad. For
 example, in GHC's own ``UniqueSupply`` monad code, we have: ::
@@ -321,6 +318,44 @@ example, in GHC's own ``UniqueSupply`` monad code, we have: ::
 See also the ``NOINLINE`` (:ref:`noinline-pragma`) and ``INLINABLE``
 (:ref:`inlinable-pragma`) pragmas.
 
+``INLINE`` pragma effects on various locations
+++++++++++++++++++++++++++++++++++++++++++++++
+
+Syntactically, an ``INLINE`` pragma for a function can be put anywhere
+its type signature could be put. This means a ``INLINE`` pragma can really
+be put on any definition site for a binding.
+This includes top-level, ``let`` and ``where`` bindings as well as default
+class methods and instance declarations.
+
+The pragma itself will only have an effect when the RHS of the binding it's applied
+to is used. For regular bindings this is straight forward but for class methods and
+instance definitions this can have surprising ramifications.
+
+If we consider a class definition with two instances like this: ::
+
+    class C a where
+        op1 :: a -> a
+
+        op2 :: [a] -> [a]
+        op2 xs = reverse (xs ++ xs)
+        {-# INLINE op2 #-}
+
+    instance C T1 where
+        op1 x = ...blah...
+
+    instance C T2 where
+        {-# INLINE op1 #-}
+        op1 x = ...blah...
+        op2 xs = ...blah...
+
+Then ``op2`` for the T1 instance will get an implicit ``INLINE`` pragma. This is because
+the RHS of the default method is used for ``op2`` which retains it's ``INLINE`` pragma.
+
+In the T2 instance ``op1`` gets an ``INLINE`` pragma and behaves accordingly. However ``op2`` for T2
+is **not** implemented by the default method. This means the pragma in the class definition doesn't apply
+to this instance. With no pragma being explicitly applied GHC will then decide on a proper inlining behaviour
+for ``T2``\s ``op2`` method on it's own.
+
 .. _inlinable-pragma:
 
 ``INLINABLE`` pragma
@@ -328,7 +363,7 @@ See also the ``NOINLINE`` (:ref:`noinline-pragma`) and ``INLINABLE``
 
 .. pragma:: INLINABLE ⟨name⟩
 
-    :where: top-level
+    :where: any function definition
 
     Suggest that the compiler always consider inlining ``name``.
 
@@ -375,7 +410,7 @@ The alternative spelling ``INLINEABLE`` is also accepted by GHC.
 
 .. pragma:: NOINLINE ⟨name⟩
 
-    :where: top-level
+    :where: any function definition
 
     Instructs the compiler not to inline a value.
 
diff --git a/docs/users_guide/exts/primitives.rst b/docs/users_guide/exts/primitives.rst
index f5107cc8b4..1a81d9ea53 100644
--- a/docs/users_guide/exts/primitives.rst
+++ b/docs/users_guide/exts/primitives.rst
@@ -318,7 +318,7 @@ Unlifted Newtypes
     Enable the use of newtypes over types with non-lifted runtime representations.
 
 GHC implements an :extension:`UnliftedNewtypes` extension as specified in
-`this GHC proposal <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0013-unlifted-newtypes.rst>`_.
+`the GHC proposal #98 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0098-unlifted-newtypes.rst>`_.
 :extension:`UnliftedNewtypes` relaxes the restrictions around what types can appear inside
 of a ``newtype``. For example, the type ::
 
@@ -393,7 +393,7 @@ Unlifted Datatypes
     result kind.
 
 GHC implements the :extension:`UnliftedDatatypes` extension as specified in
-`this GHC proposal <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-data types.rst>`_.
+`the GHC proposal #265 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0265-unlifted-datatypes.rst>`_.
 :extension:`UnliftedDatatypes` relaxes the restrictions around what result kinds
 are allowed in data declarations. For example, the type ::
 
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 60598eb623..977bb69941 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -1498,8 +1498,8 @@ of ``-W(no-)*``.
      The use of ``*`` to denote the kind of inhabited types relies on the
      :extension:`StarIsType` extension, which in a future release will be
      turned off by default and then possibly removed. The reasons for this and
-     the deprecation schedule are described in `GHC proposal #30
-     <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0030-remove-star-kind.rst>`__.
+     the deprecation schedule are described in `GHC proposal #143
+     <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0143-remove-star-kind.rst>`__.
 
      This warning allows to detect such uses of ``*`` before the actual
      breaking change takes place. The recommended fix is to replace ``*`` with
diff --git a/libraries/base/Data/Typeable/Internal.hs b/libraries/base/Data/Typeable/Internal.hs
index da786bd6d3..b1441fee84 100644
--- a/libraries/base/Data/Typeable/Internal.hs
+++ b/libraries/base/Data/Typeable/Internal.hs
@@ -572,9 +572,8 @@ pattern Con' :: forall k (a :: k). ()
              => TyCon -> [SomeTypeRep] -> TypeRep a
 pattern Con' con ks <- (splitApp -> IsCon con ks)
 
--- TODO: Remove Fun when #14253 is fixed
-{-# COMPLETE Fun, App, Con  #-}
-{-# COMPLETE Fun, App, Con' #-}
+{-# COMPLETE App, Con  #-}
+{-# COMPLETE App, Con' #-}
 
 {- Note [Con evidence]
 ~~~~~~~~~~~~~~~~~~~~~~
diff --git a/libraries/base/GHC/Base.hs b/libraries/base/GHC/Base.hs
index 52a247ffae..cecd1f28ae 100644
--- a/libraries/base/GHC/Base.hs
+++ b/libraries/base/GHC/Base.hs
@@ -17,7 +17,7 @@ GHC.Prim        Has no implementation.  It defines built-in things, and
                 copied to make GHC.Prim.hi
 
 GHC.Base        Classes: Eq, Ord, Functor, Monad
-                Types:   list, (), Int, Bool, Ordering, Char, String
+                Types:   List, (), Int, Bool, Ordering, Char, String
 
 Data.Tuple      Types: tuples, plus instances for GHC.Base classes
 
diff --git a/libraries/base/GHC/List.hs b/libraries/base/GHC/List.hs
index c3800d5d59..6cb7412936 100644
--- a/libraries/base/GHC/List.hs
+++ b/libraries/base/GHC/List.hs
@@ -18,7 +18,9 @@
 -----------------------------------------------------------------------------
 
 module GHC.List (
-   -- [] (..),          -- built-in syntax; can't be used in export list
+
+   -- The list data type
+   List,
 
    -- List-monomorphic Foldable methods and misc functions
    foldr, foldr', foldr1,
diff --git a/libraries/binary b/libraries/binary
-Subproject 55c8b3e0d2d30fee1c6b0a5c96b46c432e29e35
+Subproject 6af054b4431fa7c20bf6309536cfef7d47f2c17
diff --git a/libraries/ghc-prim/GHC/Types.hs b/libraries/ghc-prim/GHC/Types.hs
index 843da4055c..28aedb7240 100644
--- a/libraries/ghc-prim/GHC/Types.hs
+++ b/libraries/ghc-prim/GHC/Types.hs
@@ -22,16 +22,15 @@
 -----------------------------------------------------------------------------
 
 module GHC.Types (
-        -- Data types that are built-in syntax
-        -- They are defined here, but not explicitly exported
-        --
-        --    Lists:          []( [], (:) )
-        --    Type equality:  (~)( Eq# )
-
         -- * Built-in types
         Bool(..), Char(..), Int(..), Word(..),
         Float(..), Double(..),
         Ordering(..), IO(..),
+
+        List,   -- List( [], (:) )
+          -- List constructors are not exported
+          -- because they are built-in syntax
+
         isTrue#,
         SPEC(..),
         Symbol,
@@ -177,7 +176,7 @@ type family Any :: k where { }
 -- >>> ['h','e','l','l','o'] == "hello"
 -- True
 --
-data [] a = [] | a : [a]
+data List a = [] | a : List a
 
 
 {- *********************************************************************
diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md
index 0485c633af..45701629a4 100644
--- a/libraries/ghc-prim/changelog.md
+++ b/libraries/ghc-prim/changelog.md
@@ -75,7 +75,7 @@
         `unsafeThawSmallArray#`, `copySmallArray#`, `copySmallMutableArray#`, `cloneSmallArray#`,
         `cloneSmallMutableArray#`, `freezeSmallArray#`, `thawSmallArray#`, `casSmallArray#`,
 
-    - `newMutVar#`,`readMutVar#`,`writeMutV#`,`casMutVar#`,
+    - `newMutVar#`, `readMutVar#`, `writeMutVar#`,`casMutVar#`,
 
     - operations on `MVar#` and `TVar#`:
 
diff --git a/testsuite/tests/deriving/should_fail/T21302.hs b/testsuite/tests/deriving/should_fail/T21302.hs
new file mode 100644
index 0000000000..16e7cf320d
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21302.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE UndecidableInstances, TypeFamilies #-}
+
+module T21302 where
+
+data BoxAssocDouble = BoxAssocDouble (BoxAssoc Int)
+  deriving (Eq)
+
+type family Assoc a
+
+data BoxAssoc a = BoxAssoc (Assoc a)
+
+deriving instance c Eq a => Eq (BoxAssoc a)
diff --git a/testsuite/tests/deriving/should_fail/T21302.stderr b/testsuite/tests/deriving/should_fail/T21302.stderr
new file mode 100644
index 0000000000..46910cbf4f
--- /dev/null
+++ b/testsuite/tests/deriving/should_fail/T21302.stderr
@@ -0,0 +1,19 @@
+
+T21302.hs:6:13: error:
+    • Could not solve: (c0 Eq Int)
+        arising from the first field of ‘BoxAssocDouble’
+          (type ‘BoxAssoc Int’)
+    • When deriving the instance for (Eq BoxAssocDouble)
+
+T21302.hs:12:19: error:
+    • Could not deduce (c0 Eq a)
+      from the context: c Eq a
+        bound by a stand-alone deriving instance declaration:
+                   forall (c :: (* -> Constraint) -> * -> Constraint) a.
+                   c Eq a =>
+                   Eq (BoxAssoc a)
+        at T21302.hs:12:19-43
+    • In the ambiguity check for a stand-alone deriving instance declaration
+      To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
+      In the stand-alone deriving instance for
+        ‘c Eq a => Eq (BoxAssoc a)’
diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T
index 61d74b72b4..2b2f2af562 100644
--- a/testsuite/tests/deriving/should_fail/all.T
+++ b/testsuite/tests/deriving/should_fail/all.T
@@ -82,3 +82,4 @@ test('deriving-via-fail4', normal, compile_fail, [''])
 test('deriving-via-fail5', normal, compile_fail, [''])
 test('T21087', normal, compile_fail, [''])
 test('T21087b', [extra_files(['T21087b_aux.hs','T21087b_aux.hs-boot'])], multimod_compile_fail, ['T21087b', ''])
+test('T21302', normal, compile_fail, [''])
diff --git a/testsuite/tests/ghci/scripts/T12550.stdout b/testsuite/tests/ghci/scripts/T12550.stdout
index d753d4f666..0a30edf362 100644
--- a/testsuite/tests/ghci/scripts/T12550.stdout
+++ b/testsuite/tests/ghci/scripts/T12550.stdout
@@ -28,9 +28,9 @@ instance ∀ a b. Functor ((,,) a b) -- Defined in ‘GHC.Base’
 instance ∀ a b c. Functor ((,,,) a b c) -- Defined in ‘GHC.Base’
 instance ∀ r. Functor ((->) r) -- Defined in ‘GHC.Base’
 instance Functor IO -- Defined in ‘GHC.Base’
+instance Functor [] -- Defined in ‘GHC.Base’
 instance Functor Maybe -- Defined in ‘GHC.Base’
 instance Functor Solo -- Defined in ‘GHC.Base’
-instance Functor [] -- Defined in ‘GHC.Base’
 instance ∀ a. Functor (Either a) -- Defined in ‘Data.Either’
 instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★).
          (Functor f, Functor g) ⇒
diff --git a/testsuite/tests/ghci/scripts/T21294a.script b/testsuite/tests/ghci/scripts/T21294a.script
new file mode 100644
index 0000000000..e4a91a5d83
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21294a.script
@@ -0,0 +1,5 @@
+type L0 = []
+:i L0
+
+type L1 a = [a]
+:i L1
diff --git a/testsuite/tests/ghci/scripts/T21294a.stdout b/testsuite/tests/ghci/scripts/T21294a.stdout
new file mode 100644
index 0000000000..58fb4e6c27
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T21294a.stdout
@@ -0,0 +1,6 @@
+type L0 :: * -> *
+type L0 = [] :: * -> *
+  	-- Defined at <interactive>:1:1
+type L1 :: * -> *
+type L1 a = [a]
+  	-- Defined at <interactive>:4:1
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index f2d03bd8cf..9e7ca144a6 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -367,3 +367,4 @@ test('T21088', normal, ghci_script, ['T21088.script'])
 test('T21110', [extra_files(['T21110A.hs'])], ghci_script,
                 ['T21110.script'])
 test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script'])
+test('T21294a', normal, ghci_script, ['T21294a.script'])
diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout
index d03977e3b5..edb6158456 100644
--- a/testsuite/tests/ghci/scripts/ghci011.stdout
+++ b/testsuite/tests/ghci/scripts/ghci011.stdout
@@ -1,5 +1,5 @@
-type [] :: * -> *
-data [] a = [] | a : [a]
+type List :: * -> *
+data List a = [] | a : [a]
   	-- Defined in ‘GHC.Types’
 instance Monoid [a] -- Defined in ‘GHC.Base’
 instance Semigroup [a] -- Defined in ‘GHC.Base’
@@ -35,9 +35,9 @@ instance (Semigroup a, Semigroup b) => Semigroup (a, b)
 instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
 instance (Bounded a, Bounded b) => Bounded (a, b)
   -- Defined in ‘GHC.Enum’
-instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
 instance (Eq a, Eq b) => Eq (a, b) -- Defined in ‘GHC.Classes’
 instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’
+instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’
 instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’
 instance Monoid a => Applicative ((,) a) -- Defined in ‘GHC.Base’
 instance Functor ((,) a) -- Defined in ‘GHC.Base’
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.stdout b/testsuite/tests/hiefile/should_run/HieQueries.stdout
index 98f0466815..d352cc9c38 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.stdout
+++ b/testsuite/tests/hiefile/should_run/HieQueries.stdout
@@ -3,14 +3,15 @@ At point (31,9), we found:
 ==========================
 ┌
 │ $dC at HieQueries.hs:31:1-13, of type: C [a]
-│     is an evidence variable bound by a let, depending on: [$fC[], $dC]
+│     is an evidence variable bound by a let, depending on: [$fCList,
+│                                                            $dC]
 │           with scope: LocalScope HieQueries.hs:31:1-13
 │           bound at: HieQueries.hs:31:1-13
 │     Defined at <no location info>
 └
 |
 +- ┌
-|  │ $fC[] at HieQueries.hs:27:10-21, of type: forall a. C a => C [a]
+|  │ $fCList at HieQueries.hs:27:10-21, of type: forall a. C a => C [a]
 |  │     is an evidence variable bound by an instance of class C
 |  │           with scope: ModuleScope
 |  │           
@@ -30,7 +31,7 @@ At point (37,9), we found:
 ==========================
 ┌
 │ $dShow at HieQueries.hs:37:1-22, of type: Show [(Integer, x, A)]
-│     is an evidence variable bound by a let, depending on: [$fShow[],
+│     is an evidence variable bound by a let, depending on: [$fShowList,
 │                                                            $dShow]
 │           with scope: LocalScope HieQueries.hs:37:1-22
 │           bound at: HieQueries.hs:37:1-22
@@ -38,7 +39,7 @@ At point (37,9), we found:
 └
 |
 +- ┌
-|  │ $fShow[] at HieQueries.hs:37:1-22, of type: forall a. Show a => Show [a]
+|  │ $fShowList at HieQueries.hs:37:1-22, of type: forall a. Show a => Show [a]
 |  │     is a usage of an external evidence variable
 |  │     Defined in `GHC.Show'
 |  └
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.hs b/testsuite/tests/parser/should_compile/DumpParsedAst.hs
index 15b37b683c..b6c52be15b 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.hs
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Haskell2010 #-}
-{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies
+{-# LANGUAGE DataKinds, GADTs, PolyKinds, RankNTypes, TypeOperators, TypeFamilies
              , TypeApplications, TypeInType #-}
 
 module DumpParsedAst where
@@ -17,4 +17,8 @@ data T f (a :: k) = MkT (f a)
 type family F1 (a :: k) (f :: k -> Type) :: Type where
   F1 @Peano a f = T @Peano f a
 
+data family Nat :: k -> k -> Type
+newtype instance Nat (a :: k -> Type) :: (k -> Type) -> Type where
+  Nat :: (forall xx. f xx -> g xx) -> Nat f g
+
 main = putStrLn "hello"
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 38e55e1021..0f41f9a4d0 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -21,11 +21,11 @@
     []
     [(L
       (Anchor
-       { DumpParsedAst.hs:21:1 }
+       { DumpParsedAst.hs:25:1 }
        (UnchangedAnchor))
       (EpaComment
        (EpaEofComment)
-       { DumpParsedAst.hs:21:1 }))]))
+       { DumpParsedAst.hs:25:1 }))]))
   (VirtualBraces
    (1))
   (Just
@@ -900,37 +900,584 @@
   ,(L
     (SrcSpanAnn (EpAnn
                  (Anchor
-                  { DumpParsedAst.hs:20:1-23 }
+                  { DumpParsedAst.hs:20:1-33 }
                   (UnchangedAnchor))
                  (AnnListItem
                   [])
                  (EpaComments
-                  [])) { DumpParsedAst.hs:20:1-23 })
+                  [])) { DumpParsedAst.hs:20:1-33 })
+    (TyClD
+     (NoExtField)
+     (FamDecl
+      (NoExtField)
+      (FamilyDecl
+       (EpAnn
+        (Anchor
+         { DumpParsedAst.hs:20:1-33 }
+         (UnchangedAnchor))
+        [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:20:1-4 }))
+        ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:20:6-11 }))
+        ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:20:17-18 }))]
+        (EpaComments
+         []))
+       (DataFamily)
+       (TopLevel)
+       (L
+        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:13-15 })
+        (Unqual
+         {OccName: Nat}))
+       (HsQTvs
+        (NoExtField)
+        [])
+       (Prefix)
+       (L
+        (SrcSpanAnn
+         (EpAnnNotUsed)
+         { DumpParsedAst.hs:20:17-33 })
+        (KindSig
+         (NoExtField)
+         (L
+          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:20-33 })
+          (HsFunTy
+           (EpAnn
+            (Anchor
+             { DumpParsedAst.hs:20:20 }
+             (UnchangedAnchor))
+            (NoEpAnns)
+            (EpaComments
+             []))
+           (HsUnrestrictedArrow
+            (L
+             (TokenLoc
+              (EpaSpan { DumpParsedAst.hs:20:22-23 }))
+             (HsNormalTok)))
+           (L
+            (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:20 })
+            (HsTyVar
+             (EpAnn
+              (Anchor
+               { DumpParsedAst.hs:20:20 }
+               (UnchangedAnchor))
+              []
+              (EpaComments
+               []))
+             (NotPromoted)
+             (L
+              (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:20 })
+              (Unqual
+               {OccName: k}))))
+           (L
+            (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:25-33 })
+            (HsFunTy
+             (EpAnn
+              (Anchor
+               { DumpParsedAst.hs:20:25 }
+               (UnchangedAnchor))
+              (NoEpAnns)
+              (EpaComments
+               []))
+             (HsUnrestrictedArrow
+              (L
+               (TokenLoc
+                (EpaSpan { DumpParsedAst.hs:20:27-28 }))
+               (HsNormalTok)))
+             (L
+              (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:25 })
+              (HsTyVar
+               (EpAnn
+                (Anchor
+                 { DumpParsedAst.hs:20:25 }
+                 (UnchangedAnchor))
+                []
+                (EpaComments
+                 []))
+               (NotPromoted)
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:25 })
+                (Unqual
+                 {OccName: k}))))
+             (L
+              (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:30-33 })
+              (HsTyVar
+               (EpAnn
+                (Anchor
+                 { DumpParsedAst.hs:20:30-33 }
+                 (UnchangedAnchor))
+                []
+                (EpaComments
+                 []))
+               (NotPromoted)
+               (L
+                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:30-33 })
+                (Unqual
+                 {OccName: Type}))))))))))
+       (Nothing)))))
+  ,(L
+    (SrcSpanAnn (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:(21,1)-(22,45) }
+                  (UnchangedAnchor))
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  [])) { DumpParsedAst.hs:(21,1)-(22,45) })
+    (InstD
+     (NoExtField)
+     (DataFamInstD
+      (EpAnn
+       (Anchor
+        { DumpParsedAst.hs:(21,1)-(22,45) }
+        (UnchangedAnchor))
+       [(AddEpAnn AnnNewtype (EpaSpan { DumpParsedAst.hs:21:1-7 }))
+       ,(AddEpAnn AnnInstance (EpaSpan { DumpParsedAst.hs:21:9-16 }))
+       ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:39-40 }))
+       ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:21:62-66 }))]
+       (EpaComments
+        []))
+      (DataFamInstDecl
+       (FamEqn
+        (EpAnn
+         (Anchor
+          { DumpParsedAst.hs:(21,1)-(22,45) }
+          (UnchangedAnchor))
+         [(AddEpAnn AnnNewtype (EpaSpan { DumpParsedAst.hs:21:1-7 }))
+         ,(AddEpAnn AnnInstance (EpaSpan { DumpParsedAst.hs:21:9-16 }))
+         ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:39-40 }))
+         ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:21:62-66 }))]
+         (EpaComments
+          []))
+        (L
+         (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:18-20 })
+         (Unqual
+          {OccName: Nat}))
+        (HsOuterImplicit
+         (NoExtField))
+        [(HsValArg
+          (L
+           (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:22-37 })
+           (HsParTy
+            (EpAnn
+             (Anchor
+              { DumpParsedAst.hs:21:22 }
+              (UnchangedAnchor))
+             (AnnParen
+              (AnnParens)
+              (EpaSpan { DumpParsedAst.hs:21:22 })
+              (EpaSpan { DumpParsedAst.hs:21:37 }))
+             (EpaComments
+              []))
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:23-36 })
+             (HsKindSig
+              (EpAnn
+               (Anchor
+                { DumpParsedAst.hs:21:23 }
+                (UnchangedAnchor))
+               [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:25-26 }))]
+               (EpaComments
+                []))
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:23 })
+               (HsTyVar
+                (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:21:23 }
+                  (UnchangedAnchor))
+                 []
+                 (EpaComments
+                  []))
+                (NotPromoted)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:23 })
+                 (Unqual
+                  {OccName: a}))))
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:28-36 })
+               (HsFunTy
+                (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:21:28 }
+                  (UnchangedAnchor))
+                 (NoEpAnns)
+                 (EpaComments
+                  []))
+                (HsUnrestrictedArrow
+                 (L
+                  (TokenLoc
+                   (EpaSpan { DumpParsedAst.hs:21:30-31 }))
+                  (HsNormalTok)))
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:28 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:21:28 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:28 })
+                   (Unqual
+                    {OccName: k}))))
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:33-36 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:21:33-36 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:33-36 })
+                   (Unqual
+                    {OccName: Type})))))))))))]
+        (Prefix)
+        (HsDataDefn
+         (NoExtField)
+         (NewType)
+         (Nothing)
+         (Nothing)
+         (Just
+          (L
+           (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:42-60 })
+           (HsFunTy
+            (EpAnn
+             (Anchor
+              { DumpParsedAst.hs:21:42-52 }
+              (UnchangedAnchor))
+             (NoEpAnns)
+             (EpaComments
+              []))
+            (HsUnrestrictedArrow
+             (L
+              (TokenLoc
+               (EpaSpan { DumpParsedAst.hs:21:54-55 }))
+              (HsNormalTok)))
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:42-52 })
+             (HsParTy
+              (EpAnn
+               (Anchor
+                { DumpParsedAst.hs:21:42 }
+                (UnchangedAnchor))
+               (AnnParen
+                (AnnParens)
+                (EpaSpan { DumpParsedAst.hs:21:42 })
+                (EpaSpan { DumpParsedAst.hs:21:52 }))
+               (EpaComments
+                []))
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:43-51 })
+               (HsFunTy
+                (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:21:43 }
+                  (UnchangedAnchor))
+                 (NoEpAnns)
+                 (EpaComments
+                  []))
+                (HsUnrestrictedArrow
+                 (L
+                  (TokenLoc
+                   (EpaSpan { DumpParsedAst.hs:21:45-46 }))
+                  (HsNormalTok)))
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:43 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:21:43 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:43 })
+                   (Unqual
+                    {OccName: k}))))
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:48-51 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:21:48-51 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:48-51 })
+                   (Unqual
+                    {OccName: Type}))))))))
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:57-60 })
+             (HsTyVar
+              (EpAnn
+               (Anchor
+                { DumpParsedAst.hs:21:57-60 }
+                (UnchangedAnchor))
+               []
+               (EpaComments
+                []))
+              (NotPromoted)
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:21:57-60 })
+               (Unqual
+                {OccName: Type})))))))
+         [(L
+           (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:3-45 })
+           (ConDeclGADT
+            (EpAnn
+             (Anchor
+              { DumpParsedAst.hs:22:3-45 }
+              (UnchangedAnchor))
+             [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:22:7-8 }))]
+             (EpaComments
+              []))
+            [(L
+              (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:3-5 })
+              (Unqual
+               {OccName: Nat}))]
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:10-45 })
+             (HsOuterImplicit
+              (NoExtField)))
+            (Nothing)
+            (PrefixConGADT
+             [(HsScaled
+               (HsUnrestrictedArrow
+                (L
+                 (TokenLoc
+                  (EpaSpan { DumpParsedAst.hs:22:36-37 }))
+                 (HsNormalTok)))
+               (L
+                (SrcSpanAnn (EpAnn
+                             (Anchor
+                              { DumpParsedAst.hs:22:10-34 }
+                              (UnchangedAnchor))
+                             (AnnListItem
+                              [])
+                             (EpaComments
+                              [])) { DumpParsedAst.hs:22:10-34 })
+                (HsParTy
+                 (EpAnn
+                  (Anchor
+                   { DumpParsedAst.hs:22:10 }
+                   (UnchangedAnchor))
+                  (AnnParen
+                   (AnnParens)
+                   (EpaSpan { DumpParsedAst.hs:22:10 })
+                   (EpaSpan { DumpParsedAst.hs:22:34 }))
+                  (EpaComments
+                   []))
+                 (L
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:11-33 })
+                  (HsForAllTy
+                   (NoExtField)
+                   (HsForAllInvis
+                    (EpAnn
+                     (Anchor
+                      { DumpParsedAst.hs:22:11-16 }
+                      (UnchangedAnchor))
+                     ((,)
+                      (AddEpAnn AnnForall (EpaSpan { DumpParsedAst.hs:22:11-16 }))
+                      (AddEpAnn AnnDot (EpaSpan { DumpParsedAst.hs:22:20 })))
+                     (EpaComments
+                      []))
+                    [(L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:18-19 })
+                      (UserTyVar
+                       (EpAnn
+                        (Anchor
+                         { DumpParsedAst.hs:22:18-19 }
+                         (UnchangedAnchor))
+                        []
+                        (EpaComments
+                         []))
+                       (SpecifiedSpec)
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:18-19 })
+                        (Unqual
+                         {OccName: xx}))))])
+                   (L
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:22-33 })
+                    (HsFunTy
+                     (EpAnn
+                      (Anchor
+                       { DumpParsedAst.hs:22:22-25 }
+                       (UnchangedAnchor))
+                      (NoEpAnns)
+                      (EpaComments
+                       []))
+                     (HsUnrestrictedArrow
+                      (L
+                       (TokenLoc
+                        (EpaSpan { DumpParsedAst.hs:22:27-28 }))
+                       (HsNormalTok)))
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:22-25 })
+                      (HsAppTy
+                       (NoExtField)
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:22 })
+                        (HsTyVar
+                         (EpAnn
+                          (Anchor
+                           { DumpParsedAst.hs:22:22 }
+                           (UnchangedAnchor))
+                          []
+                          (EpaComments
+                           []))
+                         (NotPromoted)
+                         (L
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:22 })
+                          (Unqual
+                           {OccName: f}))))
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:24-25 })
+                        (HsTyVar
+                         (EpAnn
+                          (Anchor
+                           { DumpParsedAst.hs:22:24-25 }
+                           (UnchangedAnchor))
+                          []
+                          (EpaComments
+                           []))
+                         (NotPromoted)
+                         (L
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:24-25 })
+                          (Unqual
+                           {OccName: xx}))))))
+                     (L
+                      (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:30-33 })
+                      (HsAppTy
+                       (NoExtField)
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:30 })
+                        (HsTyVar
+                         (EpAnn
+                          (Anchor
+                           { DumpParsedAst.hs:22:30 }
+                           (UnchangedAnchor))
+                          []
+                          (EpaComments
+                           []))
+                         (NotPromoted)
+                         (L
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:30 })
+                          (Unqual
+                           {OccName: g}))))
+                       (L
+                        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:32-33 })
+                        (HsTyVar
+                         (EpAnn
+                          (Anchor
+                           { DumpParsedAst.hs:22:32-33 }
+                           (UnchangedAnchor))
+                          []
+                          (EpaComments
+                           []))
+                         (NotPromoted)
+                         (L
+                          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:32-33 })
+                          (Unqual
+                           {OccName: xx})))))))))))))])
+            (L
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:39-45 })
+             (HsAppTy
+              (NoExtField)
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:39-43 })
+               (HsAppTy
+                (NoExtField)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:39-41 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:22:39-41 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:39-41 })
+                   (Unqual
+                    {OccName: Nat}))))
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:43 })
+                 (HsTyVar
+                  (EpAnn
+                   (Anchor
+                    { DumpParsedAst.hs:22:43 }
+                    (UnchangedAnchor))
+                   []
+                   (EpaComments
+                    []))
+                  (NotPromoted)
+                  (L
+                   (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:43 })
+                   (Unqual
+                    {OccName: f}))))))
+              (L
+               (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:45 })
+               (HsTyVar
+                (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:22:45 }
+                  (UnchangedAnchor))
+                 []
+                 (EpaComments
+                  []))
+                (NotPromoted)
+                (L
+                 (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:22:45 })
+                 (Unqual
+                  {OccName: g}))))))
+            (Nothing)))]
+         []))))))
+  ,(L
+    (SrcSpanAnn (EpAnn
+                 (Anchor
+                  { DumpParsedAst.hs:24:1-23 }
+                  (UnchangedAnchor))
+                 (AnnListItem
+                  [])
+                 (EpaComments
+                  [])) { DumpParsedAst.hs:24:1-23 })
     (ValD
      (NoExtField)
      (FunBind
       (NoExtField)
       (L
-       (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:1-4 })
+       (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:1-4 })
        (Unqual
         {OccName: main}))
       (MG
        (NoExtField)
        (L
-        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:1-23 })
+        (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:1-23 })
         [(L
-          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:1-23 })
+          (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:1-23 })
           (Match
            (EpAnn
             (Anchor
-             { DumpParsedAst.hs:20:1-23 }
+             { DumpParsedAst.hs:24:1-23 }
              (UnchangedAnchor))
             []
             (EpaComments
              []))
            (FunRhs
             (L
-             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:1-4 })
+             (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:1-4 })
              (Unqual
               {OccName: main}))
             (Prefix)
@@ -942,42 +1489,42 @@
             [(L
               (SrcSpanAnn
                (EpAnnNotUsed)
-               { DumpParsedAst.hs:20:6-23 })
+               { DumpParsedAst.hs:24:6-23 })
               (GRHS
                (EpAnn
                 (Anchor
-                 { DumpParsedAst.hs:20:6-23 }
+                 { DumpParsedAst.hs:24:6-23 }
                  (UnchangedAnchor))
                 (GrhsAnn
                  (Nothing)
-                 (AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:20:6 })))
+                 (AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:24:6 })))
                 (EpaComments
                  []))
                []
                (L
-                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:8-23 })
+                (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:8-23 })
                 (HsApp
                  (EpAnn
                   (Anchor
-                   { DumpParsedAst.hs:20:8-23 }
+                   { DumpParsedAst.hs:24:8-23 }
                    (UnchangedAnchor))
                   (NoEpAnns)
                   (EpaComments
                    []))
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:8-15 })
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:8-15 })
                   (HsVar
                    (NoExtField)
                    (L
-                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:8-15 })
+                    (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:8-15 })
                     (Unqual
                      {OccName: putStrLn}))))
                  (L
-                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:20:17-23 })
+                  (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:24:17-23 })
                   (HsLit
                    (EpAnn
                     (Anchor
-                     { DumpParsedAst.hs:20:17-23 }
+                     { DumpParsedAst.hs:24:17-23 }
                      (UnchangedAnchor))
                     (NoEpAnns)
                     (EpaComments
diff --git a/testsuite/tests/parser/should_fail/T17865.hs b/testsuite/tests/parser/should_fail/T17865.hs
index b278ec09ae..31efa0596d 100644
--- a/testsuite/tests/parser/should_fail/T17865.hs
+++ b/testsuite/tests/parser/should_fail/T17865.hs
@@ -1,3 +1,9 @@
 module T17865 where
 
 data T = 'MkT
+
+data T' = ' MkT'
+
+data I a b = a ':> b
+
+data I' a b = a ' :>$ b
diff --git a/testsuite/tests/parser/should_fail/T17865.stderr b/testsuite/tests/parser/should_fail/T17865.stderr
index 786196c3a8..560144fbe5 100644
--- a/testsuite/tests/parser/should_fail/T17865.stderr
+++ b/testsuite/tests/parser/should_fail/T17865.stderr
@@ -1,2 +1,16 @@
-T17865.hs:3:10:
-    Cannot parse data constructor in a data/newtype declaration: 'MkT
+
+T17865.hs:3:11: error:
+    Illegal promotion quote mark in the declaration of
+    data/newtype constructor MkT
+
+T17865.hs:5:13: error:
+    Illegal promotion quote mark in the declaration of
+    data/newtype constructor MkT'
+
+T17865.hs:7:16: error:
+    Illegal promotion quote mark in the declaration of
+    data/newtype constructor (:>)
+
+T17865.hs:9:17: error:
+    Illegal promotion quote mark in the declaration of
+    data/newtype constructor (:>$)
diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr
index 4d8bc6666a..d4efc75d76 100644
--- a/testsuite/tests/roles/should_compile/Roles4.stderr
+++ b/testsuite/tests/roles/should_compile/Roles4.stderr
@@ -35,7 +35,7 @@ $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep
 $krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep
 $krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep
 $krep [InlPrag=[~]]
-  = GHC.Types.KindRepTyConApp GHC.Types.$tc[] ((:) $krep [])
+  = GHC.Types.KindRepTyConApp GHC.Types.$tcList ((:) $krep [])
 $krep [InlPrag=[~]]
   = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint []
 $krep [InlPrag=[~]]
diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr
index 6a6e3dc627..b06d0df7f8 100644
--- a/testsuite/tests/roles/should_compile/T8958.stderr
+++ b/testsuite/tests/roles/should_compile/T8958.stderr
@@ -59,7 +59,7 @@ $krep [InlPrag=[~]]
          $krep ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep))
 $krep [InlPrag=[~]]
   = GHC.Types.KindRepTyConApp
-      GHC.Types.$tc[]
+      GHC.Types.$tcList
       ((:) @GHC.Types.KindRep $krep [] @GHC.Types.KindRep)
 $krep [InlPrag=[~]]
   = GHC.Types.KindRepTyConApp
diff --git a/testsuite/tests/showIface/DocsInHiFileTH.stdout b/testsuite/tests/showIface/DocsInHiFileTH.stdout
index 0e9c1af6d5..1eac242a68 100644
--- a/testsuite/tests/showIface/DocsInHiFileTH.stdout
+++ b/testsuite/tests/showIface/DocsInHiFileTH.stdout
@@ -106,9 +106,9 @@ docs:
           $fCTYPEInt -> [text:
                            -- |A new instance
                          identifiers:],
-          $fCTYPE[] -> [text:
-                          -- |Another new instance
-                        identifiers:],
+          $fCTYPEList -> [text:
+                            -- |Another new instance
+                          identifiers:],
           $fDka -> [text:
                       -- |Another new instance
                     identifiers:],
diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr
index 5e8a086e6d..b67e385a98 100644
--- a/testsuite/tests/simplCore/should_compile/T15445.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15445.stderr
@@ -2,7 +2,7 @@ Rule fired: Class op + (BUILTIN)
 Rule fired: Class op fromInteger (BUILTIN)
 Rule fired: Int# -> Integer -> Int# (GHC.Num.Integer)
 Rule fired: SPEC plusTwoRec (T15445a)
-Rule fired: SPEC $fShow[] (GHC.Show)
+Rule fired: SPEC $fShowList (GHC.Show)
 Rule fired: Class op >> (BUILTIN)
 Rule fired: Class op show (BUILTIN)
 Rule fired: SPEC plusTwoRec (T15445a)
diff --git a/testsuite/tests/simplCore/should_compile/T21144.hs b/testsuite/tests/simplCore/should_compile/T21144.hs
new file mode 100644
index 0000000000..b4f8600fca
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T21144.hs
@@ -0,0 +1,4 @@
+module T21144 where
+
+peps :: a ~ Double => a
+peps = x where x = fromIntegral (floatDigits x) ** 2
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 13a8602bb7..5a23e84c75 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -389,3 +389,6 @@ test('OpaqueNoSpecConstr', normal, compile, ['-O -ddump-simpl -dsuppress-uniques
 test('OpaqueNoSpecialise', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
 test('OpaqueNoStrictArgWW', normal, compile, ['-O -fworker-wrapper-cbv -ddump-simpl -dsuppress-uniques'])
 test('OpaqueNoWW', normal, compile, ['-O -ddump-simpl -dsuppress-uniques'])
+
+test('T21144',  normal, compile, ['-O'])
+
diff --git a/testsuite/tests/typecheck/should_compile/T21315.hs b/testsuite/tests/typecheck/should_compile/T21315.hs
new file mode 100644
index 0000000000..34a8c8296f
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T21315.hs
@@ -0,0 +1,6 @@
+module T21315 where
+
+data T a = MkT a deriving (Eq, Ord)
+
+class Ord a => C a
+instance (Eq a, Ord a) => C (T a)
diff --git a/testsuite/tests/typecheck/should_compile/T21315.stderr b/testsuite/tests/typecheck/should_compile/T21315.stderr
new file mode 100644
index 0000000000..ad718569ec
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T21315.stderr
@@ -0,0 +1,4 @@
+
+T21315.hs:6:10: warning: [-Wredundant-constraints]
+    • Redundant constraint: Eq a
+    • In the instance declaration for ‘C (T a)’
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index a503d60b7c..f110e273a8 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -823,3 +823,4 @@ test('T18529', normal, compile, ['-ddump-tc -fprint-explicit-foralls -dsuppress-
 test('T21023', normal, compile, ['-ddump-types'])
 test('T21205', normal, compile, ['-O0'])
 test('T21323', normal, compile, [''])
+test('T21315', normal, compile, ['-Wredundant-constraints'])
diff --git a/testsuite/tests/typecheck/should_fail/T21338.hs b/testsuite/tests/typecheck/should_fail/T21338.hs
new file mode 100644
index 0000000000..5c89ab278d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T21338.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+
+module T21338 where
+
+import Data.Kind ( Type, Constraint )
+import Data.Proxy ( Proxy(..) )
+
+newtype K a b = K a
+
+type NP :: (Type -> Type) -> [Type] -> Type
+data NP f xs where
+
+data FieldInfo a
+
+type All :: [Type] -> Constraint
+type family All xs where {}
+
+data ConstructorInfo :: [Type] -> Type where
+  Record :: All xs => NP (K String) xs -> ConstructorInfo xs
+
+hmap :: (forall a. f a -> g a) -> h f xs -> h g xs
+hmap _ _ = undefined
+
+foo :: forall a flds. ConstructorInfo flds
+foo = undefined
+
+fieldNames :: forall (a :: Type) flds. NP (K String) flds
+fieldNames = case foo @a {- @flds -} of
+  Record np -> hmap id np
+  _ -> hmap undefined @flds
+       -- The last line caused a "No skolem info" panic on GHC 9.2 and below.
diff --git a/testsuite/tests/typecheck/should_fail/T21338.stderr b/testsuite/tests/typecheck/should_fail/T21338.stderr
new file mode 100644
index 0000000000..754763ed23
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T21338.stderr
@@ -0,0 +1,33 @@
+
+T21338.hs:38:24:
+     Couldn't match type ‘flds0’ with ‘flds’
+      Expected: NP (K String) flds
+        Actual: NP (K String) flds0
+     ‘flds0’ is untouchable
+        inside the constraints: All flds0
+        bound by a pattern with constructor:
+                   Record :: forall (xs :: [*]).
+                             All xs =>
+                             NP (K String) xs -> ConstructorInfo xs,
+                 in a case alternative
+        at T21338.hs:38:3-11
+      ‘flds’ is a rigid type variable bound by
+        the type signature for:
+          fieldNames :: forall a (flds :: [*]). NP (K String) flds
+        at T21338.hs:36:1-57
+     In the second argument of ‘hmap’, namely ‘np’
+      In the expression: hmap id np
+      In a case alternative: Record np -> hmap id np
+     Relevant bindings include
+        np :: NP (K String) flds0 (bound at T21338.hs:38:10)
+        fieldNames :: NP (K String) flds (bound at T21338.hs:37:1)
+
+T21338.hs:39:8:
+     Cannot apply expression of type ‘h0 f0 xs0 -> h0 g0 xs0’
+      to a visible type argument ‘flds’
+     In the expression: hmap undefined @flds
+      In a case alternative: _ -> hmap undefined @flds
+      In the expression:
+        case foo @a of
+          Record np -> hmap id np
+          _ -> hmap undefined @flds
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index af529398f3..c856ca7e95 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -653,3 +653,4 @@ test('T20064', normal, compile_fail, [''])
 test('T21130', normal, compile_fail, [''])
 test('T20768_fail', normal, compile_fail, [''])
 test('T21327', normal, compile_fail, [''])
+test('T21338', normal, compile_fail, [''])
diff --git a/utils/haddock b/utils/haddock
-Subproject fb0e9bac0a5297f995b151f25aa1ce3e622e12e
+Subproject d504cd50d8b660c207573864890392f02a48ca5