summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2022-06-02 15:40:59 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-06-20 12:31:45 -0400
commite4e44d8d54518fa88318e9f5ebe109839f6c180a (patch)
tree564e76bb5760c392b22648e07a9f0f5ab191824f
parent2563b95cda983cd6be23a5be01fe1f1873f1fa4f (diff)
downloadhaskell-e4e44d8d54518fa88318e9f5ebe109839f6c180a.tar.gz
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.
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs168
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs25
-rw-r--r--compiler/GHC/Tc/Gen/Sig.hs3
-rw-r--r--compiler/GHC/Tc/Utils/Instantiate.hs6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T21667.hs95
-rw-r--r--testsuite/tests/partial-sigs/should_compile/T21667.stderr6
-rw-r--r--testsuite/tests/partial-sigs/should_compile/all.T1
-rw-r--r--testsuite/tests/typecheck/should_compile/T11339c.hs5
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