compiler/GHC/Core.hs

@@ -694,7 +694,7 @@ an eta-expansion (see GHC.CoreToStg.Prep.maybeSaturate):
 However, this transformation would be invalid, because now the binding of x
 in the lambda abstraction would violate I1.
 
-See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head
+See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete
 and Note [Linting representation-polymorphic builtins] in GHC.Core.Lint for
 more details.
 

compiler/GHC/Core/DataCon.hs

@@ -456,7 +456,7 @@ data DataCon
         -- variables of unboxed tuples and unboxed sums.
         --
         -- See Note [Representation-polymorphism checking built-ins]
-        -- in GHC.Tc.Gen.Head.
+        -- in GHC.Tc.Utils.Concrete.
         dcConcreteTyVars :: ConcreteTyVars,
 
         -- The type/coercion vars in the order the user wrote them [c,y,x,b]
@@ -1309,7 +1309,7 @@ dataConUnivAndExTyCoVars (MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tv
 -- For example: the RuntimeRep variables of unboxed tuples and unboxed sums.
 --
 -- See Note [Representation-polymorphism checking built-ins]
--- in GHC.Tc.Gen.Head.
+-- in GHC.Tc.Utils.Concrete
 dataConConcreteTyVars :: DataCon -> ConcreteTyVars
 dataConConcreteTyVars (MkData { dcConcreteTyVars = concs }) = concs
 

compiler/GHC/Core/Lint.hs

@@ -49,6 +49,7 @@ import GHC.Core.DataCon
 import GHC.Core.Ppr
 import GHC.Core.Coercion
 import GHC.Core.Type as Type
+import GHC.Core.Predicate( isCoVarType )
 import GHC.Core.Multiplicity
 import GHC.Core.UsageEnv
 import GHC.Core.TyCo.Rep   -- checks validity of types/coercions
@@ -1300,7 +1301,7 @@ checkRepPolyBuiltinApp fun_id args = checkL (null not_concs) err_msg
 -- | Compute the 1-indexed positions in the outer forall'd quantified type variables
 -- of the type in which the concrete type variables occur.
 --
--- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head.
+-- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete.
 concreteTyVarPositions :: Id -> ConcreteTyVars -> IntMap ConcreteTvOrigin
 concreteTyVarPositions fun_id conc_tvs
   | isNullUFM conc_tvs

compiler/GHC/Core/Make.hs

@@ -67,9 +67,10 @@ import GHC.Types.Unique.Supply
 import GHC.Core
 import GHC.Core.Utils ( exprType, mkSingleAltCase, bindNonRec )
 import GHC.Core.Type
-import GHC.Core.TyCo.Compare( eqType )
-import GHC.Core.Coercion ( isCoVar )
-import GHC.Core.DataCon  ( DataCon, dataConWorkId )
+import GHC.Core.Predicate    ( isCoVarType )
+import GHC.Core.TyCo.Compare ( eqType )
+import GHC.Core.Coercion     ( isCoVar )
+import GHC.Core.DataCon      ( DataCon, dataConWorkId )
 import GHC.Core.Multiplicity
 
 import GHC.Builtin.Types

compiler/GHC/Core/Predicate.hs

@@ -12,7 +12,7 @@ module GHC.Core.Predicate (
 
   -- Equality predicates
   EqRel(..), eqRelRole,
-  isEqPrimPred, isEqPred,
+  isEqPrimPred, isNomEqPred, isReprEqPrimPred, isEqPred, isCoVarType,
   getEqPredTys, getEqPredTys_maybe, getEqPredRole,
   predTypeEqRel,
   mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,
@@ -60,7 +60,7 @@ data Pred
   -- | A typeclass predicate.
   = ClassPred Class [Type]
 
-  -- | A type equality predicate.
+  -- | A type equality predicate, (t1 ~#N t2) or (t1 ~#R t2)
   | EqPred EqRel Type Type
 
   -- | An irreducible predicate.
@@ -80,7 +80,7 @@ classifyPredType :: PredType -> Pred
 classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
     Just (tc, [_, _, ty1, ty2])
       | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2
-      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq ty1 ty2
+      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq  ty1 ty2
 
     Just (tc, tys)
       | Just clas <- tyConClass_maybe tc
@@ -189,16 +189,21 @@ getEqPredTys_maybe ty
       _ -> Nothing
 
 getEqPredRole :: PredType -> Role
+-- Precondition: the PredType is (s ~#N t) or (s ~#R t)
 getEqPredRole ty = eqRelRole (predTypeEqRel ty)
 
 -- | Get the equality relation relevant for a pred type.
-predTypeEqRel :: PredType -> EqRel
+-- Precondition: the PredType is (s ~#N t) or (s ~#R t)
+predTypeEqRel :: HasDebugCallStack => PredType -> EqRel
 predTypeEqRel ty
-  | Just (tc, _) <- splitTyConApp_maybe ty
-  , tc `hasKey` eqReprPrimTyConKey
-  = ReprEq
-  | otherwise
-  = NomEq
+  = case splitTyConApp_maybe ty of
+     Just (tc, _) | tc `hasKey` eqReprPrimTyConKey
+                  -> ReprEq
+                  | otherwise
+                  -> assertPpr (tc `hasKey` eqPrimTyConKey) (ppr ty)
+                     NomEq
+     _ -> pprPanic "predTypeEqRel" (ppr ty)
+
 
 {-------------------------------------------
 Predicates on PredType
@@ -219,20 +224,51 @@ see Note [Equality superclasses in quantified constraints]
 in GHC.Tc.Solver.Dict.
 -}
 
+-- | Does this type classify a core (unlifted) Coercion?
+-- At either role nominal or representational
+--    (t1 ~# t2) or (t1 ~R# t2)
+-- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep"
+isCoVarType :: Type -> Bool
+  -- ToDo: should we check saturation?
+isCoVarType ty = isEqPrimPred ty
+
 isEvVarType :: Type -> Bool
--- True of (a) predicates, of kind Constraint, such as (Eq a), and (a ~ b)
---         (b) coercion types, such as (t1 ~# t2) or (t1 ~R# t2)
+-- True of (a) predicates, of kind Constraint, such as (Eq t), and (s ~ t)
+--         (b) coercion types, such as (s ~# t) or (s ~R# t)
 -- See Note [Types for coercions, predicates, and evidence] in GHC.Core.TyCo.Rep
 -- See Note [Evidence for quantified constraints]
 isEvVarType ty = isCoVarType ty || isPredTy ty
 
+isEqPrimPred :: PredType -> Bool
+-- True of (s ~# t) (s ~R# t)
+isEqPrimPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey
+  | otherwise
+  = False
+
+isReprEqPrimPred :: PredType -> Bool
+isReprEqPrimPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqReprPrimTyConKey
+  | otherwise
+  = False
+
+isNomEqPred :: PredType -> Bool
+-- A nominal equality, primitive or not  (s ~# t), (s ~ t), or (s ~~ t)
+isNomEqPred ty
+  | Just tc <- tyConAppTyCon_maybe ty
+  = tc `hasKey` eqPrimTyConKey || tc `hasKey` heqTyConKey || tc `hasKey` eqTyConKey
+  | otherwise
+  = False
+
 isClassPred :: PredType -> Bool
 isClassPred ty = case tyConAppTyCon_maybe ty of
     Just tc -> isClassTyCon tc
     _       -> False
 
 isEqPred :: PredType -> Bool
-isEqPred ty  -- True of (a ~ b) and (a ~~ b)
+isEqPred ty  -- True of (s ~ t) and (s ~~ t)
              -- ToDo: should we check saturation?
   | Just tc <- tyConAppTyCon_maybe ty
   , Just cls <- tyConClass_maybe tc
@@ -240,10 +276,6 @@ isEqPred ty  -- True of (a ~ b) and (a ~~ b)
   | otherwise
   = False
 
-isEqPrimPred :: PredType -> Bool
-isEqPrimPred ty = isCoVarType ty
-  -- True of (a ~# b) (a ~R# b)
-
 isEqualityClass :: Class -> Bool
 -- True of (~), (~~), and Coercible
 -- These all have a single primitive-equality superclass, either (~N# or ~R#)

compiler/GHC/Core/Rules.hs

@@ -1239,7 +1239,7 @@ Two wrinkles:
           [f :-> \x p. p*p]
      but that is fine.
 
-(W2) This wrinkle concerns the overlp between the new HOP rule and the existing
+(W2) This wrinkle concerns the overlap between the new HOP rule and the existing
      decompose-application rule.  See 3.1 of GHC Proposal #555 for a discussion.
 
      Consider potential match:

compiler/GHC/Core/SimpleOpt.hs

@@ -29,27 +29,32 @@ import GHC.Core.Unfold
 import GHC.Core.Unfold.Make
 import GHC.Core.Make ( FloatBind(..), mkWildValBinder )
 import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm, zapLambdaBndrs )
+import GHC.Core.DataCon
+import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
+import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
+                            , isInScope, substTyVarBndr, cloneTyVarBndr )
+import GHC.Core.Predicate( isCoVarType )
+import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
+
 import GHC.Types.Literal
 import GHC.Types.Id
 import GHC.Types.Id.Info  ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
 import GHC.Types.Var      ( isNonCoVarId )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import GHC.Core.DataCon
 import GHC.Types.Demand( etaConvertDmdSig, topSubDmd )
 import GHC.Types.Tickish
-import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
-import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
-                            , isInScope, substTyVarBndr, cloneTyVarBndr )
-import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
+import GHC.Types.Basic
+
 import GHC.Builtin.Types
 import GHC.Builtin.Names
-import GHC.Types.Basic
+
 import GHC.Unit.Module ( Module )
 import GHC.Utils.Encoding
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
+
 import GHC.Data.Maybe       ( orElse )
 import GHC.Data.Graph.UnVar
 import Data.List (mapAccumL)

compiler/GHC/Core/TyCo/FVs.hs

@@ -59,7 +59,7 @@ import {-# SOURCE #-} GHC.Core.Coercion( coercionLKind )
 
 import GHC.Builtin.Types.Prim( funTyFlagTyCon )
 
-import Data.Monoid as DM ( Endo(..), Any(..) )
+import Data.Monoid as DM ( Any(..) )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom( coAxiomTyCon )
@@ -75,6 +75,8 @@ import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Data.Pair
 
+import Data.Semigroup
+
 {-
 %************************************************************************
 %*                                                                      *
@@ -228,6 +230,17 @@ then we won't look at it at all. If it is free, then all the variables free in i
 kind are free -- regardless of whether some local variable has the same Unique.
 So if we're looking at a variable occurrence at all, then all variables in its
 kind are free.
+
+Note [Free vars and synonyms]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When finding free variables we generally do not expand synonyms.  So given
+   type T a = Int
+the type (T [b]) will return `b` as a free variable, even though expanding the
+synonym would get rid of it.  Expanding synonyms might lead to types that look
+ill-scoped; an alternative we have not explored.
+
+But see `occCheckExpand` in this module for a function that does, selectively,
+expand synonyms to reduce free-var occurences.
 -}
 
 {- *********************************************************************
@@ -317,7 +330,7 @@ deep_cos :: [Coercion] -> Endo TyCoVarSet
 (deep_ty, deep_tys, deep_co, deep_cos) = foldTyCo deepTcvFolder emptyVarSet
 
 deepTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-deepTcvFolder = TyCoFolder { tcf_view = noView
+deepTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                            , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                            , tcf_hole  = do_hole, tcf_tycobinder = do_bndr }
   where
@@ -375,7 +388,7 @@ shallow_cos :: [Coercion] -> Endo TyCoVarSet
 (shallow_ty, shallow_tys, shallow_co, shallow_cos) = foldTyCo shallowTcvFolder emptyVarSet
 
 shallowTcvFolder :: TyCoFolder TyCoVarSet (Endo TyCoVarSet)
-shallowTcvFolder = TyCoFolder { tcf_view = noView
+shallowTcvFolder = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                               , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                               , tcf_hole  = do_hole, tcf_tycobinder = do_bndr }
   where
@@ -592,6 +605,7 @@ tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)
                                emptyVarSet   -- See Note [Closing over free variable kinds]
                                (v:acc_list, extendVarSet acc_set v)
 tyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc
+                                                    -- See Note [Free vars and synonyms]
 tyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc
 tyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc
 tyCoFVsOfType (FunTy _ w arg res)  f bound_vars acc = (tyCoFVsOfType w `unionFV` tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc
@@ -950,7 +964,9 @@ invisibleVarsOfTypes = mapUnionFV invisibleVarsOfType
 
 {-# INLINE afvFolder #-}   -- so that specialization to (const True) works
 afvFolder :: (TyCoVar -> Bool) -> TyCoFolder TyCoVarSet DM.Any
-afvFolder check_fv = TyCoFolder { tcf_view = noView
+-- 'afvFolder' is short for "any-free-var folder", good for checking
+-- if any free var of a type satisfies a predicate `check_fv`
+afvFolder check_fv = TyCoFolder { tcf_view = noView  -- See Note [Free vars and synonyms]
                                 , tcf_tyvar = do_tcv, tcf_covar = do_tcv
                                 , tcf_hole = do_hole, tcf_tycobinder = do_bndr }
   where

compiler/GHC/Core/Type.hs

@@ -113,7 +113,7 @@ module GHC.Core.Type (
         isForAllTy_ty, isForAllTy_co,
         isForAllTy_invis_ty,
         isPiTy, isTauTy, isFamFreeTy,
-        isCoVarType, isAtomicTy,
+        isAtomicTy,
 
         isValidJoinPointType,
         tyConAppNeedsKindSig,
@@ -2493,18 +2493,6 @@ isTerminatingType ty = case tyConAppTyCon_maybe ty of
     Just tc -> isClassTyCon tc && not (isNewTyCon tc)
     _       -> False
 
--- | Does this type classify a core (unlifted) Coercion?
--- At either role nominal or representational
---    (t1 ~# t2) or (t1 ~R# t2)
--- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep"
-isCoVarType :: Type -> Bool
-  -- ToDo: should we check saturation?
-isCoVarType ty
-  | Just tc <- tyConAppTyCon_maybe ty
-  = tc `hasKey` eqPrimTyConKey || tc `hasKey` eqReprPrimTyConKey
-  | otherwise
-  = False
-
 isPrimitiveType :: Type -> Bool
 -- ^ Returns true of types that are opaque to Haskell.
 isPrimitiveType ty = case splitTyConApp_maybe ty of

compiler/GHC/Core/Utils.hs

@@ -74,6 +74,7 @@ import GHC.Core.Ppr
 import GHC.Core.FVs( bindFreeVars )
 import GHC.Core.DataCon
 import GHC.Core.Type as Type
+import GHC.Core.Predicate( isCoVarType )
 import GHC.Core.FamInstEnv
 import GHC.Core.TyCo.Compare( eqType, eqTypeX )
 import GHC.Core.Coercion

compiler/GHC/Driver/Config/Core/Lint.hs

@@ -132,7 +132,7 @@ perPassFlags dflags pass
     -- we have eta-expanded data constructors with representation-polymorphic
     -- bindings; so we switch off the representation-polymorphism checks.
     -- The very simple optimiser will beta-reduce them away.
-    -- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Gen.Head.
+    -- See Note [Representation-polymorphism checking built-ins] in GHC.Tc.Utils.Concrete
     check_fixed_rep = case pass of
                         CoreDesugar -> False
                         _           -> True

compiler/GHC/Rename/Module.hs

@@ -1128,12 +1128,10 @@ rnSrcDerivDecl (DerivDecl (inst_warn_ps, ann) ty mds overlap)
        ; addNoNestedForallsContextsErr ctxt
            NFC_StandaloneDerivedInstanceHead
            (getLHsInstDeclHead $ dropWildCards ty')
-       ; warnNoDerivStrat mds' loc
        ; inst_warn_rn <- mapM rnLWarningTxt inst_warn_ps
        ; return (DerivDecl (inst_warn_rn, ann) ty' mds' overlap, fvs) }
   where
     ctxt    = DerivDeclCtx
-    loc = getLocA nowc_ty
     nowc_ty = dropWildCards ty
 
 {-
@@ -2108,18 +2106,6 @@ The main parts of the implementation are:
 
 -}
 
-warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn)
-                 -> SrcSpan
-                 -> RnM ()
-warnNoDerivStrat mds loc
-  = do { dyn_flags <- getDynFlags
-       ; case mds of
-           Nothing ->
-             addDiagnosticAt loc $ TcRnNoDerivStratSpecified
-              (xopt LangExt.DerivingStrategies dyn_flags)
-           _ -> pure ()
-       }
-
 rnLHsDerivingClause :: HsDocContext -> LHsDerivingClause GhcPs
                     -> RnM (LHsDerivingClause GhcRn, FreeVars)
 rnLHsDerivingClause doc
@@ -2129,7 +2115,6 @@ rnLHsDerivingClause doc
                               , deriv_clause_tys = dct }))
   = do { (dcs', dct', fvs)
            <- rnLDerivStrategy doc dcs $ rn_deriv_clause_tys dct
-       ; warnNoDerivStrat dcs' (locA loc)
        ; pure ( L loc (HsDerivingClause { deriv_clause_ext = noExtField
                                         , deriv_clause_strategy = dcs'
                                         , deriv_clause_tys = dct' })

compiler/GHC/SysTools/Cpp.hs

@@ -168,6 +168,9 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
     backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags
 
     let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
+
+    let asserts_def = [ "-D__GLASGOW_HASKELL_ASSERTS_IGNORED__" | gopt Opt_IgnoreAsserts dflags]
+
     -- Default CPP defines in Haskell source
     ghcVersionH <- getGhcVersionPathName dflags unit_env
     let hsSourceCppOpts = [ "-include", ghcVersionH ]
@@ -197,6 +200,7 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
                     ++ map GHC.SysTools.Option target_defs
                     ++ map GHC.SysTools.Option backend_defs
                     ++ map GHC.SysTools.Option th_defs
+                    ++ map GHC.SysTools.Option asserts_def
                     ++ map GHC.SysTools.Option hscpp_opts
                     ++ map GHC.SysTools.Option sse_defs
                     ++ map GHC.SysTools.Option fma_def

compiler/GHC/Tc/Deriv.hs

@@ -48,6 +48,7 @@ import GHC.Core.Type
 import GHC.Utils.Error
 import GHC.Core.DataCon
 import GHC.Data.Maybe
+import GHC.Types.Hint (AssumedDerivingStrategy(..))
 import GHC.Types.Name.Reader
 import GHC.Types.Name
 import GHC.Types.Name.Set as NameSet
@@ -71,6 +72,8 @@ import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Reader
 import Data.List (partition, find)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 
 {-
 ************************************************************************
@@ -415,6 +418,76 @@ in derived code.
 @makeDerivSpecs@ fishes around to find the info about needed derived instances.
 -}
 
+mechanismToAssumedStrategy :: DerivSpecMechanism -> Maybe AssumedDerivingStrategy
+mechanismToAssumedStrategy = \case
+  DerivSpecStock{} -> Just AssumedStockStrategy
+  DerivSpecAnyClass{} -> Just AssumedAnyclassStrategy
+  DerivSpecNewtype{} -> Just AssumedNewtypeStrategy
+  DerivSpecVia{} -> Nothing -- `via` is never assumed, it is always explicit
+
+warnNoDerivingClauseStrategy
+  :: Maybe (LDerivStrategy GhcTc)
+  -- ^ The given deriving strategy, if any.
+  -> [(LHsSigType GhcRn, EarlyDerivSpec)]
+  -- ^ The given deriving predicates of a deriving clause (for example 'Show' &
+  --   'Eq' in @deriving (Show, Eq)@) along with the 'EarlyDerivSpec' which we
+  --   use to find out what deriving strategy was actually used.
+  --   See comments of 'TcRnNoDerivingClauseStrategySpecified'.
+  -> TcM ()
+warnNoDerivingClauseStrategy Just{} _early_deriv_specs = pure ()
+warnNoDerivingClauseStrategy Nothing early_deriv_specs = do
+  let all_assumed_strategies :: Map AssumedDerivingStrategy [LHsSigType GhcRn]
+      all_assumed_strategies =
+        Map.unionsWith (++) (map early_deriv_spec_to_assumed_strategies early_deriv_specs)
+
+  dyn_flags <- getDynFlags
+  addDiagnosticTc $
+    TcRnNoDerivStratSpecified (xopt LangExt.DerivingStrategies dyn_flags) $
+      TcRnNoDerivingClauseStrategySpecified all_assumed_strategies
+
+  where
+    deriv_spec_to_assumed_strategy :: LHsSigType GhcRn
+                                   -> DerivSpec theta
+                                   -> Map AssumedDerivingStrategy [LHsSigType GhcRn]
+    deriv_spec_to_assumed_strategy deriv_head deriv_spec =
+      Map.fromList
+        [ (strat, [deriv_head])
+        | strat <- maybeToList $ mechanismToAssumedStrategy (ds_mechanism deriv_spec)
+        ]
+
+    early_deriv_spec_to_assumed_strategies :: (LHsSigType GhcRn, EarlyDerivSpec)
+                                           -> Map AssumedDerivingStrategy [LHsSigType GhcRn]
+    early_deriv_spec_to_assumed_strategies (deriv_head, InferTheta deriv_spec) =
+      deriv_spec_to_assumed_strategy deriv_head deriv_spec
+    early_deriv_spec_to_assumed_strategies (deriv_head, GivenTheta deriv_spec) =
+      deriv_spec_to_assumed_strategy deriv_head deriv_spec
+
+warnNoStandaloneDerivingStrategy
+  :: Maybe (LDerivStrategy GhcTc)
+  -- ^ The given deriving strategy, if any.
+  -> LHsSigWcType GhcRn
+  -- ^ The standalone deriving declaration's signature for example, the:
+  --     C a => C (T a)
+  --   part of the standalone deriving instance:
+  --     deriving instance C a => C (T a)
+  -> EarlyDerivSpec
+  -- ^ We extract the assumed deriving strategy from this.
+  -> TcM ()
+warnNoStandaloneDerivingStrategy Just{} _deriv_ty _early_deriv_spec = pure ()
+warnNoStandaloneDerivingStrategy Nothing deriv_ty early_deriv_spec =
+  case mechanismToAssumedStrategy $ early_deriv_spec_mechanism early_deriv_spec of
+    Nothing -> pure ()
+    Just assumed_strategy -> do
+      dyn_flags <- getDynFlags
+      addDiagnosticTc $
+        TcRnNoDerivStratSpecified (xopt LangExt.DerivingStrategies dyn_flags) $
+          TcRnNoStandaloneDerivingStrategySpecified assumed_strategy deriv_ty
+
+  where
+    early_deriv_spec_mechanism :: EarlyDerivSpec -> DerivSpecMechanism
+    early_deriv_spec_mechanism (InferTheta deriv_spec) = ds_mechanism deriv_spec
+    early_deriv_spec_mechanism (GivenTheta deriv_spec) = ds_mechanism deriv_spec
+
 makeDerivSpecs :: [DerivInfo]
                -> [LDerivDecl GhcRn]
                -> TcM [EarlyDerivSpec]
@@ -433,10 +506,10 @@ makeDerivSpecs deriv_infos deriv_decls
         ; eqns2 <- mapM (recoverM (pure Nothing) . deriveStandalone) deriv_decls
         ; return $ concat eqns1 ++ catMaybes eqns2 }
   where
-    deriv_clause_preds :: LDerivClauseTys GhcRn -> [LHsSigType GhcRn]
-    deriv_clause_preds (L _ dct) = case dct of
-      DctSingle _ ty -> [ty]
-      DctMulti _ tys -> tys
+    deriv_clause_preds :: LDerivClauseTys GhcRn -> LocatedC [LHsSigType GhcRn]
+    deriv_clause_preds (L loc dct) = case dct of
+      DctSingle _ ty -> L loc [ty]
+      DctMulti _ tys -> L loc tys
 
 ------------------------------------------------------------------
 -- | Process the derived classes in a single @deriving@ clause.
@@ -444,10 +517,13 @@ deriveClause :: TyCon
              -> [(Name, TcTyVar)]  -- Scoped type variables taken from tcTyConScopedTyVars
                                    -- See Note [Scoped tyvars in a TcTyCon] in "GHC.Core.TyCon"
              -> Maybe (LDerivStrategy GhcRn)
-             -> [LHsSigType GhcRn] -> SDoc
+             -> LocatedC [LHsSigType GhcRn]
+                -- ^ The location refers to the @(Show, Eq)@ part of @deriving (Show, Eq)@.
+             -> SDoc
              -> TcM [EarlyDerivSpec]
-deriveClause rep_tc scoped_tvs mb_lderiv_strat deriv_preds err_ctxt
-  = addErrCtxt err_ctxt $ do
+deriveClause rep_tc scoped_tvs mb_lderiv_strat (L loc deriv_preds) err_ctxt
+  = setSrcSpanA loc $
+    addErrCtxt err_ctxt $ do
       traceTc "deriveClause" $ vcat
         [ text "tvs"             <+> ppr tvs
         , text "scoped_tvs"      <+> ppr scoped_tvs
@@ -456,15 +532,21 @@ deriveClause rep_tc scoped_tvs mb_lderiv_strat deriv_preds err_ctxt
         , text "mb_lderiv_strat" <+> ppr mb_lderiv_strat ]
       tcExtendNameTyVarEnv scoped_tvs $ do
         (mb_lderiv_strat', via_tvs) <- tcDerivStrategy mb_lderiv_strat
-        tcExtendTyVarEnv via_tvs $
+        earlyDerivSpecs <- tcExtendTyVarEnv via_tvs $
         -- Moreover, when using DerivingVia one can bind type variables in
         -- the `via` type as well, so these type variables must also be
         -- brought into scope.
-          mapMaybeM (derivePred tc tys mb_lderiv_strat' via_tvs) deriv_preds
+          mapMaybeM
+            (\deriv_pred ->
+              do maybe_early_deriv_spec <- derivePred tc tys mb_lderiv_strat' via_tvs deriv_pred
+                 pure $ fmap (deriv_pred,) maybe_early_deriv_spec)
+            deriv_preds
           -- After typechecking the `via` type once, we then typecheck all
           -- of the classes associated with that `via` type in the
           -- `deriving` clause.
           -- See also Note [Don't typecheck too much in DerivingVia].
+        warnNoDerivingClauseStrategy mb_lderiv_strat' earlyDerivSpecs
+        return (snd <$> earlyDerivSpecs)
   where
     tvs = tyConTyVars rep_tc
     (tc, tys) = case tyConFamInstSig_maybe rep_tc of
@@ -678,10 +760,16 @@ deriveStandalone (L loc (DerivDecl (warn, _) deriv_ty mb_lderiv_strat overlap_mo
        ; if className cls == typeableClassName
          then do warnUselessTypeable
                  return Nothing
-         else Just <$> mkEqnHelp (fmap unLoc overlap_mode)
-                                 tvs' cls inst_tys'
-                                 deriv_ctxt' mb_deriv_strat'
-                                 (fmap unLoc warn) }
+         else do early_deriv_spec <-
+                   mkEqnHelp (fmap unLoc overlap_mode)
+                             tvs' cls inst_tys'
+                             deriv_ctxt' mb_deriv_strat'
+                             (fmap unLoc warn)
+                 warnNoStandaloneDerivingStrategy
+                   mb_lderiv_strat
+                   deriv_ty
+                   early_deriv_spec
+                 pure (Just early_deriv_spec) }
 
 -- Typecheck the type in a standalone deriving declaration.
 --

compiler/GHC/Tc/Errors/Ppr.hs

@@ -1417,9 +1417,16 @@ instance Diagnostic TcRnMessage where
            , interpp'SP errorVars ]
     TcRnBadlyStaged reason bind_lvl use_lvl
       -> mkSimpleDecorated $
-         text "Stage error:" <+> pprStageCheckReason reason <+>
-         hsep [text "is bound at stage" <+> ppr bind_lvl,
-               text "but used at stage" <+> ppr use_lvl]
+         vcat $
+         [ text "Stage error:" <+> pprStageCheckReason reason <+>
+           hsep [text "is bound at stage" <+> ppr bind_lvl,
+                 text "but used at stage" <+> ppr use_lvl]
+         ] ++
+         [ hsep [ text "Hint: quoting" <+> thBrackets (ppUnless (isValName n) "t") (ppr n)
+                , text "or an enclosing expression would allow the quotation to be used in an earlier stage"
+                ]
+         | StageCheckSplice n <- [reason]
+         ]
     TcRnBadlyStagedType name bind_lvl use_lvl
       -> mkSimpleDecorated $
          text "Badly staged type:" <+> ppr name <+>
@@ -3031,9 +3038,13 @@ instance Diagnostic TcRnMessage where
       _ -> [suggestExtension LangExt.DerivingStrategies]
     TcRnIllegalMultipleDerivClauses{}
       -> [suggestExtension LangExt.DerivingStrategies]
-    TcRnNoDerivStratSpecified isDSEnabled -> if isDSEnabled
-      then noHints
-      else [suggestExtension LangExt.DerivingStrategies]
+    TcRnNoDerivStratSpecified is_ds_enabled info -> do
+      let explicit_strategy_hint = case info of
+            TcRnNoDerivingClauseStrategySpecified assumed_derivings ->
+              SuggestExplicitDerivingClauseStrategies assumed_derivings
+            TcRnNoStandaloneDerivingStrategySpecified assumed_strategy deriv_sig ->
+              SuggestExplicitStandaloneDerivingStrategy assumed_strategy deriv_sig
+      explicit_strategy_hint : [suggestExtension LangExt.DerivingStrategies | not is_ds_enabled]
     TcRnStupidThetaInGadt{}
       -> noHints
     TcRnShadowedTyVarNameInFamResult{}

compiler/GHC/Tc/Errors/Types.hs

@@ -53,6 +53,7 @@ module GHC.Tc.Errors.Types (
   , Exported(..)
   , HsDocContext(..)
   , FixedRuntimeRepErrorInfo(..)
+  , TcRnNoDerivStratSpecifiedInfo(..)
 
   , ErrorItem(..), errorItemOrigin, errorItemEqRel, errorItemPred, errorItemCtLoc
 
@@ -180,7 +181,7 @@ import GHC.Tc.Utils.TcType (TcType, TcSigmaType, TcPredType,
 import GHC.Types.Basic
 import GHC.Types.Error
 import GHC.Types.Avail
-import GHC.Types.Hint (UntickedPromotedThing(..))
+import GHC.Types.Hint (UntickedPromotedThing(..), AssumedDerivingStrategy(..))
 import GHC.Types.ForeignCall (CLabelString)
 import GHC.Types.Id.Info ( RecSelParent(..) )
 import GHC.Types.Name (NamedThing(..), Name, OccName, getSrcLoc, getSrcSpan)
@@ -219,6 +220,7 @@ import qualified Data.List.NonEmpty as NE
 import           Data.Typeable (Typeable)
 import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt)
 import qualified GHC.Internal.TH.Syntax as TH
+import Data.Map.Strict (Map)
 
 import GHC.Generics ( Generic )
 import GHC.Types.Name.Env (NameEnv)
@@ -3265,20 +3267,22 @@ data TcRnMessage where
   -}
   TcRnIllegalMultipleDerivClauses :: TcRnMessage
 
-  {-| TcRnNoDerivStratSpecified is a warning implied by -Wmissing-deriving-strategies
-      and triggered by deriving clause without specified deriving strategy.
+  {-| TcRnNoDerivStratSpecified is a warning implied by
+      -Wmissing-deriving-strategies and triggered by deriving without
+      mentioning a strategy.
 
-      Example:
+      See 'TcRnNoDerivStratSpecifiedInfo' cases for examples.
 
-        data T = T
-          deriving Eq
-
-      Test cases: rename/should_compile/T15798a
-                  rename/should_compile/T15798b
-                  rename/should_compile/T15798c
+      Test cases: deriving/should_compile/T15798a
+                  deriving/should_compile/T15798b
+                  deriving/should_compile/T15798c
+                  deriving/should_compile/T24955a
+                  deriving/should_compile/T24955b
+                  deriving/should_compile/T24955c
   -}
   TcRnNoDerivStratSpecified
-    :: Bool -- True if DerivingStrategies is enabled
+    :: Bool -- ^ True if DerivingStrategies is enabled
+    -> TcRnNoDerivStratSpecifiedInfo
     -> TcRnMessage
 
   {-| TcRnStupidThetaInGadt is an error triggered by data contexts in GADT-style
@@ -6740,3 +6744,48 @@ data TypeCannotBeMarshaledReason
   | NotSimpleUnliftedType
   | NotBoxedKindAny
   deriving Generic
+
+data TcRnNoDerivStratSpecifiedInfo where
+  {-| 'TcRnNoDerivStratSpecified TcRnNoDerivingClauseStrategySpecified' is
+       a warning implied by -Wmissing-deriving-strategies and triggered by a
+       deriving clause without a specified deriving strategy.
+
+      Example:
+
+        newtype T = T Int
+          deriving (Eq, Ord, Show)
+
+      Here we would suggest fixing the deriving clause to:
+
+        deriving stock (Show)
+        deriving newtype (Eq, Ord)
+
+      Test cases: deriving/should_compile/T15798a
+                  deriving/should_compile/T15798c
+                  deriving/should_compile/T24955a
+                  deriving/should_compile/T24955b
+   -}
+  TcRnNoDerivingClauseStrategySpecified
+    :: Map AssumedDerivingStrategy [LHsSigType GhcRn]
+    -> TcRnNoDerivStratSpecifiedInfo
+
+  {-| 'TcRnNoDerivStratSpecified TcRnNoStandaloneDerivingStrategySpecified' is
+       a warning implied by -Wmissing-deriving-strategies and triggered by a
+       standalone deriving declaration without a specified deriving strategy.
+
+      Example:
+
+        data T a = T a
+        deriving instance Show a => Show (T a)
+
+      Here we would suggest fixing the instance to:
+
+        deriving stock instance Show a => Show (T a)
+
+      Test cases: deriving/should_compile/T15798b
+                  deriving/should_compile/T24955c
+   -}
+  TcRnNoStandaloneDerivingStrategySpecified
+    :: AssumedDerivingStrategy
+    -> LHsSigWcType GhcRn -- ^ The instance signature (e.g @Show a => Show (T a)@)
+    -> TcRnNoDerivStratSpecifiedInfo

compiler/GHC/Tc/Gen/Expr.hs

@@ -268,7 +268,10 @@ tcMonoExprNC (L loc expr) res_ty
         ; return (L loc expr') }
 
 ---------------
-tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+tcExpr :: HsExpr GhcRn
+       -> ExpRhoType   -- DeepSubsumption <=> when checking, this type
+                       --                     is deeply skolemised
+       -> TcM (HsExpr GhcTc)
 
 -- Use tcApp to typecheck applications, which are treated specially
 -- by Quick Look.  Specifically:

compiler/GHC/Tc/Gen/Head.hs

@@ -16,17 +16,18 @@
 -}
 
 module GHC.Tc.Gen.Head
-       ( HsExprArg(..), EValArg(..), TcPass(..)
+       ( HsExprArg(..), TcPass(..), QLFlag(..), EWrap(..)
        , AppCtxt(..), appCtxtLoc, insideExpansion
        , splitHsApps, rebuildHsApps
        , addArgWrap, isHsValArg
-       , leadingValArgs, isVisibleArg, pprHsExprArgTc
+       , leadingValArgs, isVisibleArg
 
        , tcInferAppHead, tcInferAppHead_maybe
        , tcInferId, tcCheckId, obviousSig
        , tyConOf, tyConOfET, fieldNotInType
        , nonBidirectionalErr
 
+       , pprArgInst
        , addHeadCtxt, addExprCtxt, addStmtCtxt, addFunResCtxt ) where
 
 import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig )
@@ -42,21 +43,21 @@ import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig )
 import GHC.Tc.TyCl.PatSyn( patSynBuilderOcc )
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Unify
-import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic )
 import GHC.Tc.Utils.Instantiate
 import GHC.Tc.Instance.Family ( tcLookupDataFamInst )
-import GHC.Core.FamInstEnv    ( FamInstEnvs )
-import GHC.Core.UsageEnv      ( singleUsageUE )
 import GHC.Tc.Errors.Types
 import GHC.Tc.Solver          ( InferMode(..), simplifyInfer )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Types.Origin
+import GHC.Tc.Types.Constraint( WantedConstraints )
 import GHC.Tc.Utils.TcType as TcType
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Zonk.TcType
 
 
+import GHC.Core.FamInstEnv    ( FamInstEnvs )
+import GHC.Core.UsageEnv      ( singleUsageUE )
 import GHC.Core.PatSyn( PatSyn )
 import GHC.Core.ConLike( ConLike(..) )
 import GHC.Core.DataCon
@@ -109,9 +110,8 @@ is a very local type, used only within this module and GHC.Tc.Gen.App
       The result of splitHsApps, which decomposes a HsExpr GhcRn
 
   - HsExprArg TcpInst:
-      The result of tcInstFun, which instantiates the function type
-      Adds EWrap nodes, the argument type in EValArg,
-      and the kind-checked type in ETypeArg
+      The result of tcInstFun, which instantiates the function type,
+      perhaps taking a quick look at arguments.
 
   - HsExprArg TcpTc:
       The result of tcArg, which typechecks the value args
@@ -120,19 +120,6 @@ is a very local type, used only within this module and GHC.Tc.Gen.App
 * rebuildPrefixApps is dual to splitHsApps, and zips an application
   back into a HsExpr
 
-Note [EValArg]
-~~~~~~~~~~~~~~
-The data type EValArg is the payload of the EValArg constructor of
-HsExprArg; i.e. a value argument of the application.  EValArg has two
-forms:
-
-* ValArg: payload is just the expression itself. Simple.
-
-* ValArgQL: captures the results of applying quickLookArg to the
-  argument in a ValArg.  When we later want to typecheck that argument
-  we can just carry on from where quick-look left off.  The fields of
-  ValArgQL exactly capture what is needed to complete the job.
-
 Invariants:
 
 1. With QL switched off, all arguments are ValArg; no ValArgQL
@@ -141,6 +128,17 @@ Invariants:
    under the conditions when quick-look should happen (eg the argument
    type is guarded) -- see quickLookArg
 
+Note [EValArgQL]
+~~~~~~~~~~~~~~~~
+Data constructor EValArgQL represents an argument that has been
+partly-type-checked by Quick Look: the first part of `tcApp` has been
+done, but not the second, `finishApp` part.
+
+The constuctor captures all the bits and pieces needed to complete
+typechecking.  (An alternative would to to store a function closure,
+but that's less concrete.)  See Note [Quick Look at value arguments]
+in GHC.Tc.Gen.App
+
 Note [splitHsApps]
 ~~~~~~~~~~~~~~~~~~
 The key function
@@ -165,37 +163,50 @@ data TcPass = TcpRn     -- Arguments decomposed
             | TcpInst   -- Function instantiated
             | TcpTc     -- Typechecked
 
-data HsExprArg (p :: TcPass)
-  = -- See Note [HsExprArg]
-    EValArg  { eva_ctxt   :: AppCtxt
-             , eva_arg    :: EValArg p
-             , eva_arg_ty :: !(XEVAType p) }
-
-  | ETypeArg { eva_ctxt  :: AppCtxt
-             , eva_hs_ty :: LHsWcType GhcRn  -- The type arg
-             , eva_ty    :: !(XETAType p) }  -- Kind-checked type arg
+data HsExprArg (p :: TcPass) where -- See Note [HsExprArg]
+
+  -- Data constructor EValArg represents a value argument
+  EValArg :: { ea_ctxt   :: AppCtxt
+             , ea_arg_ty :: !(XEVAType p)
+             , ea_arg    :: LHsExpr (GhcPass (XPass p)) }
+          -> HsExprArg p
+
+  -- Data constructor EValArgQL represents an argument that has been
+  -- partly-type-checked by Quick Look; see Note [EValArgQL]
+  EValArgQL :: { eaql_ctxt    :: AppCtxt
+               , eaql_arg_ty  :: Scaled TcSigmaType  -- Argument type expected by function
+               , eaql_larg    :: LHsExpr GhcRn       -- Original application, for
+                                                     -- location and error msgs
+               , eaql_tc_fun  :: (HsExpr GhcTc, AppCtxt) -- Typechecked head
+               , eaql_args    :: [HsExprArg 'TcpInst]    -- Args: instantiated, not typechecked
+               , eaql_wanted  :: WantedConstraints
+               , eaql_encl    :: Bool                  -- True <=> we have already qlUnified
+                                                       --   eaql_arg_ty and eaql_res_rho
+               , eaql_res_rho :: TcRhoType }           -- Result type of the application
+            -> HsExprArg 'TcpInst  -- Only exists in TcpInst phase
+
+  ETypeArg :: { ea_ctxt   :: AppCtxt
+              , ea_hs_ty  :: LHsWcType GhcRn  -- The type arg
+              , ea_ty_arg :: !(XETAType p) }  -- Kind-checked type arg
+           -> HsExprArg p
+
+  EPrag :: AppCtxt -> (HsPragE (GhcPass (XPass p))) -> HsExprArg p
+  EWrap :: EWrap                                    -> HsExprArg p
+
+type family XETAType (p :: TcPass) where  -- Type arguments
+  XETAType 'TcpRn = NoExtField
+  XETAType _      = Type
 
-  | EPrag    AppCtxt
-             (HsPragE (GhcPass (XPass p)))
+type family XEVAType (p :: TcPass) where   -- Value arguments
+  XEVAType 'TcpInst = Scaled TcSigmaType
+  XEVAType _        = NoExtField
 
-  | EWrap    EWrap
+data QLFlag = DoQL | NoQL
 
 data EWrap = EPar    AppCtxt
            | EExpand HsThingRn
            | EHsWrap HsWrapper
 
-data EValArg (p :: TcPass) where  -- See Note [EValArg]
-  ValArg   :: LHsExpr (GhcPass (XPass p))
-           -> EValArg p
-
-  ValArgQL :: { va_expr :: LHsExpr GhcRn        -- Original application
-                                                -- For location and error msgs
-              , va_fun  :: (HsExpr GhcTc, AppCtxt) -- Function of the application,
-                                                   -- typechecked, plus its context
-              , va_args :: [HsExprArg 'TcpInst] -- Args, instantiated
-              , va_ty   :: TcRhoType }          -- Result type
-           -> EValArg 'TcpInst  -- Only exists in TcpInst phase
-
 data AppCtxt
   = VAExpansion
        HsThingRn
@@ -207,6 +218,7 @@ data AppCtxt
        SrcSpan             -- The SrcSpan of the application (f e1 e2 e3)
                          --    noSrcSpan if outermost; see Note [AppCtxt]
 
+
 {- Note [AppCtxt]
 ~~~~~~~~~~~~~~~~~
 In a call (f e1 ... en), we pair up each argument with an AppCtxt. For
@@ -242,32 +254,28 @@ insideExpansion :: AppCtxt -> Bool
 insideExpansion (VAExpansion {}) = True
 insideExpansion (VACall {})      = False -- but what if the VACall has a generated context?
 
+instance Outputable QLFlag where
+  ppr DoQL = text "DoQL"
+  ppr NoQL = text "NoQL"
+
 instance Outputable AppCtxt where
   ppr (VAExpansion e l _) = text "VAExpansion" <+> ppr e <+> ppr l
   ppr (VACall f n l)    = text "VACall" <+> int n <+> ppr f  <+> ppr l
 
-type family XPass p where
+type family XPass (p :: TcPass) where
   XPass 'TcpRn   = 'Renamed
   XPass 'TcpInst = 'Renamed
   XPass 'TcpTc   = 'Typechecked
 
-type family XETAType p where  -- Type arguments
-  XETAType 'TcpRn = NoExtField
-  XETAType _      = Type
-
-type family XEVAType p where  -- Value arguments
-  XEVAType 'TcpRn = NoExtField
-  XEVAType _      = Scaled Type
-
 mkEValArg :: AppCtxt -> LHsExpr GhcRn -> HsExprArg 'TcpRn
-mkEValArg ctxt e = EValArg { eva_arg = ValArg e, eva_ctxt = ctxt
-                           , eva_arg_ty = noExtField }
+mkEValArg ctxt e = EValArg { ea_arg = e, ea_ctxt = ctxt
+                           , ea_arg_ty = noExtField }
 
 mkETypeArg :: AppCtxt -> LHsWcType GhcRn -> HsExprArg 'TcpRn
 mkETypeArg ctxt hs_ty =
-  ETypeArg { eva_ctxt = ctxt
-           , eva_hs_ty = hs_ty
-           , eva_ty = noExtField }
+  ETypeArg { ea_ctxt = ctxt
+           , ea_hs_ty = hs_ty
+           , ea_ty_arg = noExtField }
 
 addArgWrap :: HsWrapper -> [HsExprArg p] -> [HsExprArg p]
 addArgWrap wrap args
@@ -344,6 +352,8 @@ splitHsApps e = go e (top_ctxt 0 e) []
       = pure ( (op, VACall op 0 (locA l))
              ,   mkEValArg (VACall op 1 generatedSrcSpan) arg1
                : mkEValArg (VACall op 2 generatedSrcSpan) arg2
+                    -- generatedSrcSpan because this the span of the call,
+                    -- and its hard to say exactly what that is
                : EWrap (EExpand (OrigExpr e))
                : args )
 
@@ -365,380 +375,45 @@ splitHsApps e = go e (top_ctxt 0 e) []
 -- representation-polymorphic unlifted newtypes have been eta-expanded.
 --
 -- See Note [Eta-expanding rep-poly unlifted newtypes].
-rebuildHsApps :: HsExpr GhcTc
-                      -- ^ the function being applied
-              -> AppCtxt
-              -> [HsExprArg 'TcpTc]
-                      -- ^ the arguments to the function
-              -> TcRhoType
-                      -- ^ result type of the application
-              -> TcM (HsExpr GhcTc)
-rebuildHsApps fun ctxt args app_res_rho
-  = do { rejectRepPolyNewtypes args app_res_rho fun
-       ; return $ rebuild_hs_apps fun ctxt args }
-
--- | The worker function for 'rebuildHsApps': simply rebuilds
--- an application chain in which arguments are specified as
--- typechecked 'HsExprArg's.
-rebuild_hs_apps :: HsExpr GhcTc
+rebuildHsApps :: (HsExpr GhcTc, AppCtxt)
                       -- ^ the function being applied
-              -> AppCtxt
               -> [HsExprArg 'TcpTc]
                       -- ^ the arguments to the function
               -> HsExpr GhcTc
-rebuild_hs_apps fun _ [] = fun
-rebuild_hs_apps fun ctxt (arg : args)
+rebuildHsApps (fun, _) [] = fun
+rebuildHsApps (fun, ctxt) (arg : args)
   = case arg of
-      EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt' }
-        -> rebuild_hs_apps (HsApp noExtField lfun arg) ctxt' args
-      ETypeArg { eva_hs_ty = hs_ty, eva_ty = ty, eva_ctxt = ctxt' }
-        -> rebuild_hs_apps (HsAppType ty lfun hs_ty) ctxt' args
+      EValArg { ea_arg = arg, ea_ctxt = ctxt' }
+        -> rebuildHsApps (HsApp noExtField lfun arg, ctxt') args
+      ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_ctxt = ctxt' }
+        -> rebuildHsApps (HsAppType ty lfun hs_ty, ctxt') args
       EPrag ctxt' p
-        -> rebuild_hs_apps (HsPragE noExtField p lfun) ctxt' args
+        -> rebuildHsApps (HsPragE noExtField p lfun, ctxt') args
       EWrap (EPar ctxt')
-        -> rebuild_hs_apps (gHsPar lfun) ctxt' args
+        -> rebuildHsApps (gHsPar lfun, ctxt') args
       EWrap (EExpand orig)
         | OrigExpr oe <- orig
-        -> rebuild_hs_apps (mkExpandedExprTc oe fun) ctxt args
+        -> rebuildHsApps (mkExpandedExprTc oe fun, ctxt) args
         | otherwise
-        -> rebuild_hs_apps fun ctxt args
+        -> rebuildHsApps (fun, ctxt) args
       EWrap (EHsWrap wrap)
-        -> rebuild_hs_apps (mkHsWrap wrap fun) ctxt args
+        -> rebuildHsApps (mkHsWrap wrap fun, ctxt) args
   where
     lfun = L (noAnnSrcSpan $ appCtxtLoc' ctxt) fun
     appCtxtLoc' (VAExpansion _ _ l) = l
     appCtxtLoc' v = appCtxtLoc v
 
-{- Note [Representation-polymorphic Ids with no binding]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We cannot have representation-polymorphic or levity-polymorphic
-function arguments. See Note [Representation polymorphism invariants]
-in GHC.Core.  That is checked in 'GHC.Tc.Gen.App.tcInstFun', see the call
-to 'matchActualFunTy', which performs the representation-polymorphism
-check.
-
-However, some special Ids have representation-polymorphic argument
-types. These are all GHC built-ins or data constructors. They have no binding;
-instead they have compulsory unfoldings. Specifically, these Ids are:
-
-1. Some wired-in Ids, such as coerce, oneShot and unsafeCoerce# (which is only
-   partly wired-in),
-2. Representation-polymorphic primops, such as raise#.
-3. Representation-polymorphic data constructors: unboxed tuples
-   and unboxed sums.
-4. Newtype constructors with `UnliftedNewtypes` which have
-   a representation-polymorphic argument.
-
-For (1) consider
-  badId :: forall r (a :: TYPE r). a -> a
-  badId = unsafeCoerce# @r @r @a @a
-
-The (partly) wired-in function
-  unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
-                   (a :: TYPE r1) (b :: TYPE r2).
-                   a -> b
-has a convenient but representation-polymorphic type. It has no
-binding; instead it has a compulsory unfolding, after which we
-would have
-  badId = /\r /\(a :: TYPE r). \(x::a). ...body of unsafeCorece#...
-And this is no good because of that rep-poly \(x::a).  So we want
-to reject this.
-
-On the other hand
-  goodId :: forall (a :: Type). a -> a
-  goodId = unsafeCoerce# @LiftedRep @LiftedRep @a @a
-
-is absolutely fine, because after we inline the unfolding, the \(x::a)
-is representation-monomorphic.
-
-Test cases: T14561, RepPolyWrappedVar2.
-
-For primops (2) and unboxed tuples/sums (3), the situation is similar;
-they are eta-expanded in CorePrep to be saturated, and that eta-expansion
-must not add a representation-polymorphic lambda.
-
-Test cases: T14561b, RepPolyWrappedVar, UnliftedNewtypesCoerceFail.
-
-The Note [Representation-polymorphism checking built-ins] explains how we handle
-cases (1) (2) and (3).
-
-For (4), consider a representation-polymorphic newtype with
-UnliftedNewtypes:
-
-  type Id :: forall r. TYPE r -> TYPE r
-  newtype Id a where { MkId :: a }
-
-  bad :: forall r (a :: TYPE r). a -> Id a
-  bad = MkId @r @a             -- Want to reject
-
-  good :: forall (a :: Type). a -> Id a
-  good = MkId @LiftedRep @a   -- Want to accept
-
-Test cases: T18481, UnliftedNewtypesLevityBinder
-
-(4) is handled differently than (1) (2) and (3);
-see Note [Eta-expanding rep-poly unlifted newtypes].
-
-Note [Representation-polymorphism checking built-ins]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Some primops and wired-in functions are representation-polymorphic, but must
-only be instantiated at particular, concrete representations.
-There are three cases, all for `hasNoBinding` Ids:
-
-* Wired-in Ids.  For example, `seq`
-  is a wired-in Id, defined in GHC.Types.Id.Make.seqId, with this type:
-
-  seq :: forall {r} a (b :: TYPE r). a -> b -> b
-
-  It is more like a macro than a regular Id: it has /compulsory/ unfolding, so
-  we inline it at every call site.  At those call sites we should instantiate
-  `r` with a concrete RuntimeRep, so that the lambda has a concrete representation.
-  So somehow the type checker has to ensure that `seq` is called with a concrete
-  instantiation for `r`.
-
-  NB: unsafeCoerce# is not quite wired-in (see Note [Wiring in unsafeCoerce#] in GHC.HsToCore),
-  but it gets a similar treatment.
-
-* PrimOps. Some representation-polymorphic primops must be called at a concrete
-  type.  For example:
-
-  catch# :: forall {r} {l} (k :: TYPE r) (w :: TYPE (BoxedRep l)).
-              (State# RealWorld -> (# State# RealWorld, k #) )
-           -> (w -> State# RealWorld -> (# State# RealWorld, k #) )
-           -> State# RealWorld -> (# State# RealWorld, k #)
-
-  This primop pushes a "catch frame" on the stack, which must "know"
-  the return convention of `k`.  So `k` must be concrete, so we know
-  what kind of catch-frame to push. (See #21868 for more details.
-
-  So again we want to ensure that `r` is instantiated with a concrete RuntimeRep.
-
-* Unboxed-tuple data constructors.  Consider the unboxed pair data constructor:
-
-  (#,#) :: forall {r1} {r2} (a :: TYPE r1) (b :: TYPE r2). a -> b -> (# a, b #)
-
-  Again, we need concrete `r1` and `r2`. For example, we want to reject
-
-    f :: forall r (a :: TYPE r). a -> (# Int, a #)
-    f = (#,#) 3
-
-As pointed out in #21906; we see here that it is not enough to simply check
-the representation of the argument types, as for example "k :: TYPE r" in the
-type of catch# occurs in negative position but not directly as the type of
-an argument.
-
-NB: we specifically *DO NOT* handle representation-polymorphic unlifted newtypes
-with this mechanism. See Note [Eta-expanding rep-poly unlifted newtypes] for an
-overview of representation-polymorphism checks for those.
-
-To achieve this goal, for these these three kinds of `hasNoBinding` functions:
-
-* We identify the quantified variable `r` as a "concrete quantifier"
-
-* When instantiating a concrete quantifier, such as `r`, at a call site, we
-  instantiate with a ConcreteTv meta-tyvar, `r0[conc]`.
-  See Note [ConcreteTv] in GHC.Tc.Utils.Concrete.
-
-Now the type checker will ensure that `r0` is instantiated with a concrete
-RuntimeRep.
-
-Here are the moving parts:
-
-* In the IdDetails of an Id, we record a mapping from type variable name
-  to concreteness information, in the form of a ConcreteTvOrigin.
-  See 'idDetailsConcreteTvs'.
-
-  The ConcreteTvOrigin is used to determine which error message to show
-  to the user if the type variable gets instantiated to a non-concrete type;
-  this is slightly more granular than simply storing a set of type variable names.
-
-* The domain of this NameEnv is the outer forall'd TyVars of that
-  Id's type.  (A bit yukky because it means that alpha-renaming that type
-  would be invalid.  But we never do that.)  So `seq` has
-    Type:       forall {r} a (b :: TYPE r). a -> b -> b
-    IdDetails:  RepPolyId [ r :-> ConcreteFRR (FixedRuntimeRepOrigin b (..)) ]
-
-* When instantiating the type of an Id at a call site, at the call to
-  GHC.Tc.Utils.Instantiate.instantiateSigma in GHC.Tc.Gen.App.tcInstFun,
-  create ConcreteTv metavariables (instead of TauTvs) based on the
-  ConcreteTyVars stored in the IdDetails of the Id.
-
-Note that the /only/ place that one of these restricted rep-poly Ids can enter
-typechecking is in `tcInferId`, and all the interesting cases then land
-in `tcInstFun` where we take care to instantantiate those concrete
-type variables correctly.
-
-  Design alternative: in some ways, it would be more kosher for the concrete-ness
-  to be stored in the /type/, thus  forall (r[conc] :: RuntimeRep). ty.
-  But that pollutes Type for a very narrow use-case; so instead we adopt the
-  more ad-hoc solution described above.
-
-Examples:
-
-  ok :: forall (a :: Type) (b :: Type). a -> b -> b
-  ok = seq
-
-  bad :: forall s (b :: TYPE s). Int -> b -> b
-  bad x = seq x
-
-    Here we will instantiate the RuntimeRep skolem variable r from the type
-    of seq to a concrete metavariable rr[conc].
-    For 'ok' we will unify rr := LiftedRep, and for 'bad' we will fail to
-    solve rr[conc] ~# s[sk] and report a representation-polymorphism error to
-    the user.
-
-  type RR :: RuntimeRep
-  type family RR where { RR = IntRep }
-
-  tricky1, tricky2 :: forall (b :: TYPE RR). Int -> b -> b
-  tricky1 = seq
-  tricky2 = seq @RR
-
-    'tricky1' proceeds as above: we instantiate r |-> rr[conc], get a Wanted
-    rr[conc] ~# RR, which we solve by rewriting the type family.
-
-    For 'tricky2', we again create a fresh ConcreteTv metavariable rr[conc],
-    and we then proceed as if the user had written "seq @rr", but adding an
-    additional [W] rr ~ RR to the constraint solving context.
-
-[Wrinkle: VTA]
-
-  We must also handle the case when the user has instantiated the type variables
-  themselves, with a visible type application. We do this in GHC.Tc.Gen.App.tcVTA.
-
-  For example:
-
-    type F :: Type -> RuntimeRep
-    type family F a where { F Bool = IntRep }
-
-    foo = (# , #) @(F Bool) @FloatRep
-
-  We want to accept "foo" even though "F Bool" is not a concrete RuntimeRep.
-  We proceed as follows (see tcVTA):
-
-    - create a fresh concrete metavariable kappa,
-    - emit [W] F Bool ~ kappa[conc]
-    - pretend the user wrote (#,#) @kappa.
-
-  The solver will then unify kappa := IntRep, after rewriting the type family
-  application on the LHS of the Wanted.
-
-  Note that this is a bit of a corner case: only a few built-ins, such as
-  unsafeCoerce# and unboxed tuples, have specified (not inferred) RuntimeRep
-  quantified variables which can be instantiated by the user with a
-  visible type application.
-  For example,
-
-    coerce :: forall {r :: RuntimeRep} (a :: TYPE r) (b :: TYPE r)
-           .  Coercible a b => a -> b
-
-  does not allow the RuntimeRep argument to be specified by a visible type
-  application.
-
-Note [Eta-expanding rep-poly unlifted newtypes]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Any occurrence of a newtype constructor must appear at a known representation.
-If the newtype is applied to an argument, then we are done: by (I2) in
-Note [Representation polymorphism invariants], the argument has a known
-representation, and we are done. So we are left with the situation of an
-unapplied newtype constructor. For example:
-
-  type N :: TYPE r -> TYPE r
-  newtype N a = MkN a
-
-  ok :: N Int# -> N Int#
-  ok = MkN
-
-  bad :: forall r (a :: TYPE r). N (# Int, r #) -> N (# Int, r #)
-  bad = MkN
-
-The difficulty is that, unlike the situation described in
-Note [Representation-polymorphism checking built-ins],
-it is not necessarily the case that we simply need to check the instantiation
-of a single variable. Consider for example:
-
-  type RR :: Type -> Type -> RuntimeRep
-  type family RR a b where ...
-
-  type T :: forall a -> forall b -> TYPE (RR a b)
-  type family T a b where ...
-
-  type M :: forall a -> forall b -> TYPE (RR a b)
-  newtype M a b = MkM (T a b)
-
-Now, suppose we instantiate MkM, say with two types X, Y from the environment:
-
-  foo :: T X Y -> M X Y
-  foo = MkM @X @Y
-
-we need to check that we can eta-expand MkM, for which we need to know the
-representation of its argument, which is "RR X Y".
-
-To do this, in "rejectRepPolyNewtypes", we perform a syntactic representation-
-polymorphism check on the instantiated argument of the newtype, and reject
-the definition if the representation isn't concrete (in the sense of Note [Concrete types]
-in GHC.Tc.Utils.Concrete).
-
-For example, we would accept "ok" above, as "IntRep" is a concrete RuntimeRep.
-However, we would reject "foo", because "RR X Y" is not a concrete RuntimeRep.
-If we wanted to accept "foo" (performing a PHASE 2 check (in the sense of
-Note [The Concrete mechanism] in GHC.Tc.Utils.Concrete), we would have to
-significantly re-engineer unlifted newtypes in GHC. Currently, "MkM" has type:
-
-  MkM :: forall a b. T a b %1 -> M a b
-
-However, we should only be able to use MkM when we know the representation of
-T a b (which is RR a b). This means that MkM should instead have type:
-
-  MkM :: forall {must_be_conc} a b (co :: RR a b ~# must_be_conc)
-      .  T a b |> GRefl Nominal (TYPE co) %1 -> M a b
-
-where "must_be_conc" is a skolem type variable that must be instantiated to
-a concrete type, just as in Note [Representation-polymorphism checking built-ins].
-This means that any instantiation of "MkM", such as "MkM @X @Y" from "foo",
-would create a fresh concrete metavariable "gamma[conc]" and emit a Wanted constraint
-
-  [W] co :: RR X Y ~# gamma[conc]
-
-However, this all seems like a lot of work for a feature that no one is asking for,
-so we decided to keep the much simpler syntactic check. Note that one possible
-advantage of this approach is that we should be able to stop skipping
-representation-polymorphism checks in the output of the desugarer; see (C) in
-Wrinkle [Representation-polymorphic lambdas] in Note [Typechecking data constructors].
--}
-
--- | Reject any unsaturated use of an unlifted newtype constructor
--- if the representation of its argument isn't known.
---
--- See Note [Eta-expanding rep-poly unlifted newtypes].
-rejectRepPolyNewtypes :: [HsExprArg 'TcpTc]
-                      -> TcRhoType
-                      -> HsExpr GhcTc
-                      -> TcM ()
-rejectRepPolyNewtypes _applied_args app_res_rho fun = case fun of
-
-  XExpr (ConLikeTc (RealDataCon con) _ _)
-    -- Check that this is an unsaturated occurrence of a
-    -- representation-polymorphic newtype constructor.
-    | isNewDataCon con
-    , not $ tcHasFixedRuntimeRep $ dataConTyCon con
-    , Just (_rem_arg_af, _rem_arg_mult, rem_arg_ty, _nt_res_ty)
-        <- splitFunTy_maybe app_res_rho
-    -> do { let frr_ctxt = FRRRepPolyUnliftedNewtype con
-          ; hasFixedRuntimeRep_syntactic frr_ctxt rem_arg_ty }
-
-  _ -> return ()
 
 isHsValArg :: HsExprArg id -> Bool
 isHsValArg (EValArg {}) = True
 isHsValArg _            = False
 
-leadingValArgs :: [HsExprArg id] -> [EValArg id]
-leadingValArgs []                        = []
-leadingValArgs (arg@(EValArg {}) : args) = eva_arg arg : leadingValArgs args
-leadingValArgs (EWrap {}    : args)      = leadingValArgs args
-leadingValArgs (EPrag {}    : args)      = leadingValArgs args
-leadingValArgs (ETypeArg {} : _)         = []
+leadingValArgs :: [HsExprArg 'TcpRn] -> [LHsExpr GhcRn]
+leadingValArgs []                                = []
+leadingValArgs (EValArg { ea_arg = arg } : args) = arg : leadingValArgs args
+leadingValArgs (EWrap {}    : args)              = leadingValArgs args
+leadingValArgs (EPrag {}    : args)              = leadingValArgs args
+leadingValArgs (ETypeArg {} : _)                 = []
 
 isValArg :: HsExprArg id -> Bool
 isValArg (EValArg {}) = True
@@ -750,27 +425,32 @@ isVisibleArg (ETypeArg {}) = True
 isVisibleArg _             = False
 
 instance OutputableBndrId (XPass p) => Outputable (HsExprArg p) where
-  ppr (EValArg { eva_arg = arg })      = text "EValArg" <+> ppr arg
-  ppr (EPrag _ p)                      = text "EPrag" <+> ppr p
-  ppr (ETypeArg { eva_hs_ty = hs_ty }) = char '@' <> ppr hs_ty
-  ppr (EWrap wrap)                     = ppr wrap
+  ppr (EPrag _ p)                     = text "EPrag" <+> ppr p
+  ppr (ETypeArg { ea_hs_ty = hs_ty }) = char '@' <> ppr hs_ty
+  ppr (EWrap wrap)                    = ppr wrap
+  ppr (EValArg { ea_arg = arg, ea_ctxt = ctxt })
+    = text "EValArg" <> braces (ppr ctxt) <+> ppr arg
+  ppr (EValArgQL { eaql_tc_fun = fun, eaql_args = args, eaql_res_rho = ty})
+    = hang (text "EValArgQL" <+> ppr fun)
+         2 (vcat [ ppr args, text "ea_ql_ty:" <+> ppr ty ])
+
+pprArgInst :: HsExprArg 'TcpInst -> SDoc
+-- Ugh!  A special version for 'TcpInst, se we can print the arg_ty of EValArg
+pprArgInst (EPrag _ p)                     = text "EPrag" <+> ppr p
+pprArgInst (ETypeArg { ea_hs_ty = hs_ty }) = char '@' <> ppr hs_ty
+pprArgInst (EWrap wrap)                    = ppr wrap
+pprArgInst (EValArg { ea_arg = arg, ea_arg_ty = ty })
+  = hang (text "EValArg" <+> ppr arg)
+       2 (text "arg_ty" <+> ppr ty)
+pprArgInst (EValArgQL { eaql_tc_fun = fun, eaql_args = args, eaql_res_rho = ty})
+  = hang (text "EValArgQL" <+> ppr fun)
+       2 (vcat [ vcat (map pprArgInst args), text "ea_ql_ty:" <+> ppr ty ])
 
 instance Outputable EWrap where
   ppr (EPar _)       = text "EPar"
   ppr (EHsWrap w)    = text "EHsWrap" <+> ppr w
   ppr (EExpand orig) = text "EExpand" <+> ppr orig
 
-instance OutputableBndrId (XPass p) => Outputable (EValArg p) where
-  ppr (ValArg e) = ppr e
-  ppr (ValArgQL { va_fun = fun, va_args = args, va_ty = ty})
-    = hang (text "ValArgQL" <+> ppr fun)
-         2 (vcat [ ppr args, text "va_ty:" <+> ppr ty ])
-
-pprHsExprArgTc :: HsExprArg 'TcpInst -> SDoc
-pprHsExprArgTc (EValArg { eva_arg = tm, eva_arg_ty = ty })
-  = text "EValArg" <+> hang (ppr tm) 2 (dcolon <+> ppr ty)
-pprHsExprArgTc arg = ppr arg
-
 {- Note [Desugar OpApp in the typechecker]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Operator sections are desugared in the renamer; see GHC.Rename.Expr
@@ -1115,7 +795,7 @@ tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
 tcCheckId name res_ty
   = do { (expr, actual_res_ty) <- tcInferId name
        ; traceTc "tcCheckId" (vcat [ppr name, ppr actual_res_ty, ppr res_ty])
-       ; addFunResCtxt rn_fun [] actual_res_ty res_ty $
+       ; addFunResCtxt expr [] actual_res_ty res_ty $
          tcWrapResultO (OccurrenceOf name) rn_fun expr actual_res_ty res_ty }
   where
     rn_fun = HsVar noExtField (noLocA name)
@@ -1358,7 +1038,7 @@ Wrinkles
          ( /\r (a :: TYPE r). \ (x %p :: a). K @r @a x) @IntRep @Int#
            :: Int# -> T IntRep Int#
 
-         See Note [Representation-polymorphic Ids with no binding] in GHC.Tc.Gen.Head.
+         See Note [Representation-polymorphic Ids with no binding] in GHC.Tc.Utils.Concrete
 
       C. In the output of the desugarer in (4) above, we have a representation
          polymorphic lambda, which Lint would normally reject. So for that one
@@ -1476,7 +1156,7 @@ naughtiness in both branches.  c.f. GHC.Tc.TyCl.Utils.mkRecSelBinds.
 *                                                                      *
 ********************************************************************* -}
 
-addFunResCtxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn]
+addFunResCtxt :: HsExpr GhcTc -> [HsExprArg p]
               -> TcType -> ExpRhoType
               -> TcM a -> TcM a
 -- When we have a mis-match in the return type of a function

compiler/GHC/Tc/Gen/Match.hs

@@ -361,12 +361,14 @@ tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty
                   ; return (HsDo res_ty doExpr (L l stmts')) }
           else do { expanded_expr <- expandDoStmts doExpr stmts
                                                -- Do expansion on the fly
-                  ; mkExpandedExprTc (HsDo noExtField doExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty }
+                  ; mkExpandedExprTc (HsDo noExtField doExpr ss) <$>
+                    tcExpr (unLoc expanded_expr) res_ty }
         }
 
 tcDoStmts mDoExpr@(MDoExpr _) ss@(L _ stmts) res_ty
   = do  { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly
-        ; mkExpandedExprTc (HsDo noExtField mDoExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty  }
+        ; mkExpandedExprTc (HsDo noExtField mDoExpr ss) <$>
+          tcExpr (unLoc expanded_expr) res_ty  }
 
 tcDoStmts MonadComp (L l stmts) res_ty
   = do  { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty
@@ -1201,7 +1203,7 @@ the variables they bind into scope, and typecheck the thing_inside.
 -}
 
 -- | @checkArgCounts@ takes a @[RenamedMatch]@ and decides whether the same
--- number of /required/ args are used in each equation.
+-- number of /required/ (aka visible) args are used in each equation.
 -- Returns the arity, the number of required args
 -- E.g.  f @a True  y = ...
 --       f    False z = ...
@@ -1229,5 +1231,5 @@ checkArgCounts (MG { mg_alts = L _ (match1:matches) })
     mb_bad_matches = NE.nonEmpty [m | m <- matches, reqd_args_in_match m /= n_args1]
 
     reqd_args_in_match :: LocatedA (Match GhcRn body1) -> VisArity
-    -- Counts the number of /required/ args in the match
+    -- Counts the number of /required/ (aka visible) args in the match
     reqd_args_in_match (L _ (Match { m_pats = pats })) = count (isVisArgPat . unLoc) pats