Instantiate top level foralls in partial type signatures

The main fix for #21667 is the new call to tcInstTypeBnders
in tcHsPartialSigType. It was really a simple omission before.

I also moved the decision about whether we need to apply the
Monomorphism Restriction, from `decideGeneralisationPlan` to
`tcPolyInfer`.  That removes a flag from the InferGen constructor,
which is good.

But more importantly, it allows the new function,
   checkMonomorphismRestriction
called from `tcPolyInfer`, to "see" the `Types` involved rather than
the `HsTypes`.  And that in turn matters because we invoke the MR for
partial signatures if none of the partial signatures in the group have
any overloading context; and we can't answer that question for HsTypes.
See Note [Partial type signatures and the monomorphism restriction]
in GHC.Tc.Gen.Bind.

This latter is really a pre-existing bug.

8 files changed, 228 insertions, 81 deletions

diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 14f7bbf6b5..08c4ca664c 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -505,7 +505,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc closed bind_list
     ; traceTc "Generalisation plan" (ppr plan)
     ; result@(_, poly_ids) <- case plan of
          NoGen              -> tcPolyNoGen rec_tc prag_fn sig_fn bind_list
-         InferGen mn        -> tcPolyInfer rec_tc prag_fn sig_fn mn bind_list
+         InferGen           -> tcPolyInfer rec_tc prag_fn sig_fn bind_list
          CheckGen lbind sig -> tcPolyCheck prag_fn sig lbind
 
     ; mapM_ (\ poly_id ->
@@ -698,20 +698,20 @@ tcPolyInfer
   :: RecFlag       -- Whether it's recursive after breaking
                    -- dependencies based on type signatures
   -> TcPragEnv -> TcSigFun
-  -> Bool         -- True <=> apply the monomorphism restriction
   -> [LHsBind GhcRn]
   -> TcM (LHsBinds GhcTc, [TcId])
-tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
+tcPolyInfer rec_tc prag_fn tc_sig_fn bind_list
   = do { (tclvl, wanted, (binds', mono_infos))
              <- pushLevelAndCaptureConstraints  $
                 tcMonoBinds rec_tc tc_sig_fn LetLclBndr bind_list
 
+       ; apply_mr <- checkMonomorphismRestriction mono_infos bind_list
+       ; traceTc "tcPolyInfer" (ppr apply_mr $$ ppr (map mbi_sig mono_infos))
+
        ; let name_taus  = [ (mbi_poly_name info, idType (mbi_mono_id info))
                           | info <- mono_infos ]
              sigs       = [ sig | MBI { mbi_sig = Just sig } <- mono_infos ]
-             infer_mode = if mono then ApplyMR else NoRestrictions
-
-       ; mapM_ (checkOverloadedSig mono) sigs
+             infer_mode = if apply_mr then ApplyMR else NoRestrictions
 
        ; traceTc "simplifyInfer call" (ppr tclvl $$ ppr name_taus $$ ppr wanted)
        ; ((qtvs, givens, ev_binds, insoluble), residual)
@@ -740,6 +740,59 @@ tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
        ; return (unitBag abs_bind, poly_ids) }
          -- poly_ids are guaranteed zonked by mkExport
 
+checkMonomorphismRestriction :: [MonoBindInfo] -> [LHsBind GhcRn] -> TcM Bool
+-- True <=> apply the MR
+checkMonomorphismRestriction mbis lbinds
+  | null partial_sigs  -- The normal case
+  = do { mr_on <- xoptM LangExt.MonomorphismRestriction
+       ; let mr_applies = mr_on && any (restricted . unLoc) lbinds
+       ; when mr_applies $ mapM_ checkOverloadedSig sigs
+       ; return mr_applies }
+
+  | otherwise    -- See Note [Partial type signatures and the monomorphism restriction]
+  = return (all is_mono_psig partial_sigs)
+
+  where
+    sigs, partial_sigs :: [TcIdSigInst]
+    sigs          = [sig | MBI { mbi_sig = Just sig } <- mbis]
+    partial_sigs  = [sig | sig@(TISI { sig_inst_sig = PartialSig {} }) <- sigs]
+
+    complete_sig_bndrs :: NameSet
+    complete_sig_bndrs
+      = mkNameSet [ idName bndr
+                  | TISI { sig_inst_sig = CompleteSig { sig_bndr = bndr }} <- sigs ]
+
+    is_mono_psig (TISI { sig_inst_theta = theta, sig_inst_wcx = mb_extra_constraints })
+       = null theta && isNothing mb_extra_constraints
+
+    -- The Haskell 98 monomorphism restriction
+    restricted (PatBind {})                              = True
+    restricted (VarBind { var_id = v })                  = no_sig v
+    restricted (FunBind { fun_id = v, fun_matches = m }) = restricted_match m
+                                                           && no_sig (unLoc v)
+    restricted b = pprPanic "isRestrictedGroup/unrestricted" (ppr b)
+
+    restricted_match mg = matchGroupArity mg == 0
+        -- No args => like a pattern binding
+        -- Some args => a function binding
+
+    no_sig nm = not (nm `elemNameSet` complete_sig_bndrs)
+
+checkOverloadedSig :: TcIdSigInst -> TcM ()
+-- Example:
+--   f :: Eq a => a -> a
+--   K f = e
+-- The MR applies, but the signature is overloaded, and it's
+-- best to complain about this directly
+-- c.f #11339
+checkOverloadedSig sig
+  | not (null (sig_inst_theta sig))
+  , let orig_sig = sig_inst_sig sig
+  = setSrcSpan (sig_loc orig_sig) $
+    failWith $ TcRnOverloadedSig orig_sig
+  | otherwise
+  = return ()
+
 --------------
 mkExport :: TcPragEnv
          -> WantedConstraints  -- residual constraints, already emitted (for errors only)
@@ -994,22 +1047,6 @@ warnMissingSignatures id
         ; let dia = TcRnPolymorphicBinderMissingSig (idName id) tidy_ty
         ; addDiagnosticTcM (env1, dia) }
 
-checkOverloadedSig :: Bool -> TcIdSigInst -> TcM ()
--- Example:
---   f :: Eq a => a -> a
---   K f = e
--- The MR applies, but the signature is overloaded, and it's
--- best to complain about this directly
--- c.f #11339
-checkOverloadedSig monomorphism_restriction_applies sig
-  | not (null (sig_inst_theta sig))
-  , monomorphism_restriction_applies
-  , let orig_sig = sig_inst_sig sig
-  = setSrcSpan (sig_loc orig_sig) $
-    failWith $ TcRnOverloadedSig orig_sig
-  | otherwise
-  = return ()
-
 {- Note [Partial type signatures and generalisation]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If /any/ of the signatures in the group is a partial type signature
@@ -1035,14 +1072,33 @@ It might be possible to fix these difficulties somehow, but there
 doesn't seem much point.  Indeed, adding a partial type signature is a
 way to get per-binding inferred generalisation.
 
-We apply the MR if /all/ of the partial signatures lack a context.
-In particular (#11016):
+Note [Partial type signatures and the monomorphism restriction]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We apply the MR if /none/ of the partial signatures has a context. e.g.
+   f :: _ -> Int
+   f x = rhs
+The partial type signature says, in effect, "there is no context", which
+amounts to appplying the MR. Indeed, saying
+   f :: _
+   f = rhs
+is a way for forcing the MR to apply.
+
+But we /don't/ want to apply the MR if the partial signatures do have
+a context  e.g. (#11016):
    f2 :: (?loc :: Int) => _
    f2 = ?loc
 It's stupid to apply the MR here.  This test includes an extra-constraints
 wildcard; that is, we don't apply the MR if you write
    f3 :: _ => blah
 
+But watch out.  We don't want to apply the MR to
+   type Wombat a = forall b. Eq b => ...b...a...
+   f4 :: Wombat _
+Here f4 doesn't /look/ as if it has top-level overloading, but in fact it
+does, hidden under Wombat.  We can't "see" that because we only have access
+to the HsType at the moment.  That's why we do the check in
+checkMonomorphismRestriction.
+
 Note [Quantified variables in partial type signatures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
@@ -1632,79 +1688,55 @@ data GeneralisationPlan
   = NoGen               -- No generalisation, no AbsBinds
 
   | InferGen            -- Implicit generalisation; there is an AbsBinds
-       Bool             --   True <=> apply the MR; generalise only unconstrained type vars
 
-  | CheckGen (LHsBind GhcRn) TcIdSigInfo
-                        -- One FunBind with a signature
-                        -- Explicit generalisation
+  | CheckGen            -- One FunBind with a complete signature:
+       (LHsBind GhcRn)  --   do explicit generalisation
+       TcIdSigInfo      -- Always CompleteSig
 
 -- A consequence of the no-AbsBinds choice (NoGen) is that there is
 -- no "polymorphic Id" and "monmomorphic Id"; there is just the one
 
 instance Outputable GeneralisationPlan where
   ppr NoGen          = text "NoGen"
-  ppr (InferGen b)   = text "InferGen" <+> ppr b
+  ppr InferGen       = text "InferGen"
   ppr (CheckGen _ s) = text "CheckGen" <+> ppr s
 
 decideGeneralisationPlan
    :: DynFlags -> TopLevelFlag -> IsGroupClosed -> TcSigFun
    -> [LHsBind GhcRn] -> GeneralisationPlan
 decideGeneralisationPlan dflags top_lvl closed sig_fn lbinds
-  | has_partial_sigs                         = InferGen (and partial_sig_mrs)
   | Just (bind, sig) <- one_funbind_with_sig = CheckGen bind sig
-  | do_not_generalise                        = NoGen
-  | otherwise                                = InferGen mono_restriction
+  | generalise_binds                         = InferGen
+  | otherwise                                = NoGen
   where
-    binds = map unLoc lbinds
-
-    partial_sig_mrs :: [Bool]
-    -- One for each partial signature (so empty => no partial sigs)
-    -- The Bool is True if the signature has no constraint context
-    --      so we should apply the MR
-    -- See Note [Partial type signatures and generalisation]
-    partial_sig_mrs
-      = [ null $ fromMaybeContext mtheta
-        | TcIdSig (PartialSig { psig_hs_ty = hs_ty })
-            <- mapMaybe sig_fn (collectHsBindListBinders CollNoDictBinders lbinds)
-        , let (mtheta, _) = splitLHsQualTy (hsSigWcType hs_ty) ]
-
-    has_partial_sigs = not (null partial_sig_mrs)
-
-    mono_restriction  = xopt LangExt.MonomorphismRestriction dflags
-                     && any restricted binds
-
-    do_not_generalise
-      | isTopLevel top_lvl             = False
+    generalise_binds
+      | isTopLevel top_lvl             = True
         -- See Note [Always generalise top-level bindings]
 
-      | IsGroupClosed _ True <- closed = False
+      | IsGroupClosed _ True <- closed = True
         -- The 'True' means that all of the group's
         -- free vars have ClosedTypeId=True; so we can ignore
         -- -XMonoLocalBinds, and generalise anyway
 
-      | otherwise = xopt LangExt.MonoLocalBinds dflags
+      | has_partial_sigs = True
+        -- See Note [Partial type signatures and generalisation]
+
+      | otherwise = not (xopt LangExt.MonoLocalBinds dflags)
 
     -- With OutsideIn, all nested bindings are monomorphic
-    -- except a single function binding with a signature
+    -- except a single function binding with a complete signature
     one_funbind_with_sig
       | [lbind@(L _ (FunBind { fun_id = v }))] <- lbinds
-      , Just (TcIdSig sig) <- sig_fn (unLoc v)
+      , Just (TcIdSig sig@(CompleteSig {})) <- sig_fn (unLoc v)
       = Just (lbind, sig)
       | otherwise
       = Nothing
 
-    -- The Haskell 98 monomorphism restriction
-    restricted (PatBind {})                              = True
-    restricted (VarBind { var_id = v })                  = no_sig v
-    restricted (FunBind { fun_id = v, fun_matches = m }) = restricted_match m
-                                                           && no_sig (unLoc v)
-    restricted b = pprPanic "isRestrictedGroup/unrestricted" (ppr b)
-
-    restricted_match mg = matchGroupArity mg == 0
-        -- No args => like a pattern binding
-        -- Some args => a function binding
-
-    no_sig n = not (hasCompleteSig sig_fn n)
+    binders          = collectHsBindListBinders CollNoDictBinders lbinds
+    has_partial_sigs = any has_partial_sig binders
+    has_partial_sig nm = case sig_fn nm of
+      Just (TcIdSig (PartialSig {})) -> True
+      _                              -> False
 
 isClosedBndrGroup :: TcTypeEnv -> Bag (LHsBind GhcRn) -> IsGroupClosed
 isClosedBndrGroup type_env binds
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 54a38a70b4..8d666fb7b0 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -96,7 +96,8 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr
 import GHC.Tc.Utils.TcType
 import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBindersN,
-                                  tcInstInvisibleTyBinder, tcSkolemiseInvisibleBndrs )
+                                  tcInstInvisibleTyBinder, tcSkolemiseInvisibleBndrs,
+                                  tcInstTypeBndrs )
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim
 import GHC.Types.Error
@@ -3975,12 +3976,13 @@ tcHsPartialSigType ctxt sig_ty
        -- See Note [Extra-constraint holes in partial type signatures]
        ; mapM_ emitNamedTypeHole wcs
 
-       -- Zonk, so that any nested foralls can "see" their occurrences
-       -- See Note [Checking partial type signatures], and in particular
-       -- Note [Levels for wildcards]
-       ; outer_tv_bndrs <- mapM zonkInvisTVBinder outer_tv_bndrs
-       ; theta          <- mapM zonkTcType theta
-       ; tau            <- zonkTcType tau
+         -- The "tau" from tcHsPartialSigType might very well have some foralls
+         -- at the top, hidden behind a type synonym. Instantiate them! E.g.
+         --    type T x = forall b. x -> b -> b
+         --    f :: forall a. T (a,_)
+         -- We must instantiate the `forall b` just as we do the `forall a`!
+         -- Missing this led to #21667.
+       ; (tv_prs', theta', tau) <- tcInstTypeBndrs tau
 
          -- We return a proper (Name,InvisTVBinder) environment, to be sure that
          -- we bring the right name into scope in the function body.
@@ -3990,6 +3992,13 @@ tcHsPartialSigType ctxt sig_ty
              tv_prs :: [(Name,InvisTVBinder)]
              tv_prs = outer_bndr_names `zip` outer_tv_bndrs
 
+       -- Zonk, so that any nested foralls can "see" their occurrences
+       -- See Note [Checking partial type signatures], and in particular
+       -- Note [Levels for wildcards]
+       ; tv_prs <- mapSndM zonkInvisTVBinder (tv_prs ++ tv_prs')
+       ; theta  <- mapM    zonkTcType        (theta ++ theta')
+       ; tau    <- zonkTcType                tau
+
       -- NB: checkValidType on the final inferred type will be
       --     done later by checkInferredPolyId.  We can't do it
       --     here because we don't have a complete type to check
@@ -4042,7 +4051,7 @@ we do the following
   source-code LHsSigWcType
 
 * Then, for f and g /separately/, we call tcInstSig, which in turn
-  call tchsPartialSig (defined near this Note).  It kind-checks the
+  call tcHsPartialSig (defined near this Note).  It kind-checks the
   LHsSigWcType, creating fresh unification variables for each "_"
   wildcard.  It's important that the wildcards for f and g are distinct
   because they might get instantiated completely differently.  E.g.
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 66c7c80ced..69e65ce2d1 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -505,7 +505,7 @@ tcInstSig :: TcIdSigInfo -> TcM TcIdSigInst
 -- Instantiate a type signature; only used with plan InferGen
 tcInstSig sig@(CompleteSig { sig_bndr = poly_id, sig_loc = loc })
   = setSrcSpan loc $  -- Set the binding site of the tyvars
-    do { (tv_prs, theta, tau) <- tcInstTypeBndrs poly_id
+    do { (tv_prs, theta, tau) <- tcInstTypeBndrs (idType poly_id)
               -- See Note [Pattern bindings and complete signatures]
 
        ; return (TISI { sig_inst_sig   = sig
@@ -522,6 +522,7 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty
     do { traceTc "Staring partial sig {" (ppr hs_sig)
        ; (wcs, wcx, tv_prs, theta, tau) <- tcHsPartialSigType ctxt hs_ty
          -- See Note [Checking partial type signatures] in GHC.Tc.Gen.HsType
+
        ; let inst_sig = TISI { sig_inst_sig   = hs_sig
                              , sig_inst_skols = tv_prs
                              , sig_inst_wcs   = wcs
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 4284b35d5e..cbe8f03be9 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -476,10 +476,10 @@ tcInstType inst_tyvars id
     (tyvars, rho) = tcSplitForAllInvisTyVars (idType id)
     (theta, tau)  = tcSplitPhiTy rho
 
-tcInstTypeBndrs :: Id -> TcM ([(Name, InvisTVBinder)], TcThetaType, TcType)
+tcInstTypeBndrs :: Type -> TcM ([(Name, InvisTVBinder)], TcThetaType, TcType)
                      -- (type vars, preds (incl equalities), rho)
 -- Instantiate the binders of a type signature with TyVarTvs
-tcInstTypeBndrs id
+tcInstTypeBndrs poly_ty
   | null tyvars   -- There may be overloading despite no type variables;
                   --      (?x :: Int) => Int -> Int
   = return ([], theta, tau)
@@ -489,7 +489,7 @@ tcInstTypeBndrs id
              subst'  = extendTCvInScopeSet subst (tyCoVarsOfType rho)
        ; return (tv_prs, substTheta subst' theta, substTy subst' tau) }
   where
-    (tyvars, rho) = splitForAllInvisTVBinders (idType id)
+    (tyvars, rho) = splitForAllInvisTVBinders poly_ty
     (theta, tau)  = tcSplitPhiTy rho
 
     inst_invis_bndr :: TCvSubst -> InvisTVBinder
diff --git a/testsuite/tests/partial-sigs/should_compile/T21667.hs b/testsuite/tests/partial-sigs/should_compile/T21667.hs
new file mode 100644
index 0000000000..907dc091dc
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/T21667.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+
+module T21667 where
+
+import GHC.TypeLits
+import Data.Kind
+import Data.Functor.Identity
+import Data.Functor.Const
+import Data.Functor
+
+
+-- import fluff
+type ASetter s t a b = (a -> Identity b) -> s -> Identity t
+type Getting r s a = (a -> Const r a) -> s -> Const r s
+type Lens s t a b = forall f . Functor f => (a -> f b) -> (s -> f t)
+type Traversal s t a b = forall g . Applicative g => (a -> g b) -> (s -> g t)
+
+set :: ASetter s t a b -> b -> s -> t
+set = undefined
+
+view :: MonadReader s m => Getting a s a -> m a
+view = undefined
+
+class Monad m => MonadReader r (m :: Type -> Type) | m -> r where
+instance MonadReader r ((->) r) where
+
+
+-- test case
+
+data Item (a :: Type) (f :: Symbol -> Type -> Type)
+
+l :: Lens (Item a f) (Item a' g) (f "1" ()) (g "1" ())
+l = undefined
+
+type ExoticTraversal' a y f = Traversal
+          (Item a f)
+          (Item a f)
+          (f y ())
+          (f y ())
+
+test :: forall a f. ExoticTraversal' a _ f
+-- The point here is that we must skolemise all the forall'd
+-- variables of test at once; but some are visible (a,b), and
+-- some are hidden (the forall g. hidden under Traversal).
+-- That led to #21667
+test f x = f (view l x) <&> \w -> set l w x
+
+{- A variety of isomorphic signatures for test
+
+test :: Traversal
+          (Item a f)
+          (Item a f)
+          (f _ ())
+          (f _ ())
+
+test :: forall a f. forall g . Applicative g
+                    => (f _ () -> g (f _ ()))
+                    -> (Item a f -> g (Item a f))
+
+test :: forall a f. forall g . Applicative g
+                    => (f "1" () -> g (f "1" ()))
+                    -> (Item a f -> g (Item a f))
+
+test :: forall a f g . Applicative g
+                    => (f _ () -> g (f _ ()))
+                    -> (Item a f -> g (Item a f))
+-}
+
+
+{- The error reported in #21667
+
+    • Couldn't match type ‘a0’ with ‘a’
+        arising from a functional dependency between:
+          constraint ‘MonadReader (Item a0 f) ((->) (Item a f))’
+            arising from a use of ‘view’
+          instance ‘MonadReader r ((->) r)’ at T21667.hs:29:10-31
+    • ‘a0’ is untouchable
+        inside the constraints: Applicative g
+        bound by a type expected by the context:
+                   forall (g :: Type -> Type).
+                   Applicative g =>
+                   (f "1" () -> g (f "1" ())) -> Item a f -> g (Item a f)
+        at T21667.hs:53:1-43
+      ‘a’ is a rigid type variable bound by
+        the inferred type of
+          test :: forall (g1 :: Type -> Type).
+                  Applicative g1 =>
+                  (f "1" () -> g1 (f "1" ())) -> Item a f -> g1 (Item a f)
+        at T21667.hs:50:16
+-}
\ No newline at end of file
diff --git a/testsuite/tests/partial-sigs/should_compile/T21667.stderr b/testsuite/tests/partial-sigs/should_compile/T21667.stderr
new file mode 100644
index 0000000000..9720853aa2
--- /dev/null
+++ b/testsuite/tests/partial-sigs/should_compile/T21667.stderr
@@ -0,0 +1,6 @@
+
+T21667.hs:46:40: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘"1" :: Symbol’
+    • In the second argument of ‘ExoticTraversal'’, namely ‘_’
+      In the type ‘ExoticTraversal' a _ f’
+      In the type signature: test :: forall a f. ExoticTraversal' a _ f
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index bb7c58a576..1a786bd363 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -103,3 +103,4 @@ test('T14658', normal, compile, [''])
 test('T18646', normal, compile, [''])
 test('T20921', normal, compile, [''])
 test('InstanceGivenOverlap3', expect_broken(20076), compile, [''])
+test('T21667', normal, compile, [''])
diff --git a/testsuite/tests/typecheck/should_compile/T11339c.hs b/testsuite/tests/typecheck/should_compile/T11339c.hs
index 0104a24765..0053da352b 100644
--- a/testsuite/tests/typecheck/should_compile/T11339c.hs
+++ b/testsuite/tests/typecheck/should_compile/T11339c.hs
@@ -12,8 +12,11 @@ failing left right afb s = case pins t of
   [] -> right afb s
   _  -> t afb
   where
-    t :: Applicative f => (a -> f b) -> f t
     -- Works because of MonoLocalBinds
+    -- But the type signature (from T11339b) is wrong:
+    --   t :: Applicative f => (a -> f b) -> f t
+    -- The type signature forces us to generalise, but the MR applies,
+    --  so the function can't be overloaded
     Bazaar { getBazaar = t } = left sell s
 
     sell :: a -> Bazaar a b b