Use partial-sig constraints as givens

In TcSimplify.simplifyInfer, use the context of a partial type
signature as 'givens' when simplifying the inferred constraints of the
group.  This way we get maximum benefit from them.  See
Note [Add signature contexts as givens].

This (finally) fixes test EqualityConstraints in Trac #9478.

And it's a nice tidy-up.

compiler/typecheck/TcBinds.hs

@@ -777,10 +777,10 @@ chooseInferredQuantifiers :: TcThetaType   -- inferred
                           -> Maybe TcIdSigInfo
                           -> TcM ([TcTyBinder], TcThetaType)
 chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
-  = -- No type signature for this binder
+  = -- No type signature (partial or complete) for this binder,
     do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
                         -- Include kind variables!  Trac #7916
-             my_theta = pickQuantifiablePreds free_tvs [] inferred_theta
+             my_theta = pickCapturedPreds free_tvs inferred_theta
              binders  = [ mkNamedBinder Invisible tv
                         | tv <- qtvs
                         , tv `elemVarSet` free_tvs ]
@@ -804,16 +804,15 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
   = do { annotated_theta <- zonkTcTypes annotated_theta
        ; let free_tvs = closeOverKinds (tyCoVarsOfTypes annotated_theta
                                         `unionVarSet` tau_tvs)
-             my_theta = pickQuantifiablePreds free_tvs annotated_theta inferred_theta
+             my_theta = pickCapturedPreds free_tvs inferred_theta
 
        -- Report the inferred constraints for an extra-constraints wildcard/hole as
        -- an error message, unless the PartialTypeSignatures flag is enabled. In this
        -- case, the extra inferred constraints are accepted without complaining.
-       -- Returns the annotated constraints combined with the inferred constraints.
+       -- NB: inferred_theta already includes all the annotated constraints
              inferred_diff = [ pred
                              | pred <- my_theta
                              , all (not . (`eqType` pred)) annotated_theta ]
-             final_theta   = annotated_theta ++ inferred_diff
        ; partial_sigs      <- xoptM LangExt.PartialTypeSignatures
        ; warn_partial_sigs <- woptM Opt_WarnPartialTypeSignatures
        ; msg <- mkLongErrAt loc (mk_msg inferred_diff partial_sigs hs_ty) empty
@@ -827,7 +826,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
                 | otherwise         -> return ()
            False                    -> reportError msg
 
-       ; return (mk_binders free_tvs, final_theta) }
+       ; return (mk_binders free_tvs, my_theta) }
 
   | otherwise  -- A complete type signature is dealt with in mkInferredPolyId
   = pprPanic "chooseInferredQuantifiers" (ppr bndr_info)

compiler/typecheck/TcSimplify.hs

@@ -539,6 +539,9 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
              , text "(unzonked) wanted =" <+> ppr wanteds
              ]
 
+       ; let partial_sigs  = filter isPartialSig sigs
+             psig_theta    = concatMap sig_theta partial_sigs
+
        -- First do full-blown solving
        -- NB: we must gather up all the bindings from doing
        -- this solving; hence (runTcSWithEvBinds ev_binds_var).
@@ -547,20 +550,26 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
        -- bindings, so we can't just revert to the input
        -- constraint.
 
-       ; ev_binds_var <- TcM.newTcEvBinds
-       ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $
-           do { sig_derived <- concatMapM mkSigDerivedWanteds sigs
-                  -- the False says we don't really need to solve all Deriveds
-              ; runTcSWithEvBinds False (Just ev_binds_var) $
-                solveWanteds (wanteds `addSimples` listToBag sig_derived) }
+       ; tc_lcl_env      <- TcM.getLclEnv
+       ; ev_binds_var    <- TcM.newTcEvBinds
+       ; psig_theta_vars <- mapM TcM.newEvVar psig_theta
+       ; wanted_transformed_incl_derivs
+            <- setTcLevel rhs_tclvl $
+               runTcSWithEvBinds False (Just ev_binds_var) $
+               do { let loc = mkGivenLoc rhs_tclvl UnkSkol tc_lcl_env
+                  ; psig_givens <- mkGivensWithSuperClasses loc psig_theta_vars
+                  ; _ <- solveSimpleGivens psig_givens
+                         -- See Note [Add signature contexts as givens]
+                  ; solveWanteds wanteds }
        ; wanted_transformed_incl_derivs <- TcM.zonkWC wanted_transformed_incl_derivs
 
        -- Find quant_pred_candidates, the predicates that
        -- we'll consider quantifying over
-       -- NB: We do not do any defaulting when inferring a type, this can lead
-       -- to less polymorphic types, see Note [Default while Inferring]
+       -- NB1: wanted_transformed does not include anything provable from
+       --      the psig_theta; it's just the extra bit
+       -- NB2: We do not do any defaulting when inferring a type, this can lead
+       --      to less polymorphic types, see Note [Default while Inferring]
 
-       ; tc_lcl_env <- TcM.getLclEnv
        ; let wanted_transformed = dropDerivedWC wanted_transformed_incl_derivs
        ; quant_pred_candidates   -- Fully zonked
            <- if insolubleWC rhs_tclvl wanted_transformed_incl_derivs
@@ -604,15 +613,10 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
        -- NB: quant_pred_candidates is already fully zonked
 
        -- Decide what type variables and constraints to quantify
-       ; let (bndrs, taus) = unzip name_taus
-             partial_sigs  = filter isPartialSig sigs
-             psig_theta    = concatMap sig_theta partial_sigs
-             -- psig_theta: see Note [Quantification and partial signatures]
-       ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus)
-       ; let zonked_tau_dvs = splitDepVarsOfTypes zonked_taus
-       ; (qtvs, bound_theta)
-           <- decideQuantification apply_mr bndrs psig_theta
-                                   quant_pred_candidates zonked_tau_dvs
+       -- NB: bound_theta are constraints we want to quantify over,
+       --     /apart from/ the psig_theta, which we always quantify over
+       ; (qtvs, bound_theta) <- decideQuantification apply_mr name_taus psig_theta
+                                                     quant_pred_candidates
 
          -- Promote any type variables that are free in the inferred type
          -- of the function:
@@ -626,15 +630,12 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
          -- we don't quantify over beta (since it is fixed by envt)
          -- so we must promote it!  The inferred type is just
          --   f :: beta -> beta
-       ; zonked_tau_tkvs <- TcM.zonkTyCoVarsAndFV $
-                            dVarSetToVarSet (dv_kvs zonked_tau_dvs)
-                            `unionVarSet`
-                            dVarSetToVarSet (dv_tvs zonked_tau_dvs)
+       ; zonked_taus <- mapM (TcM.zonkTcType . snd) name_taus
               -- decideQuantification turned some meta tyvars into
               -- quantified skolems, so we have to zonk again
 
        ; let phi_tkvs = tyCoVarsOfTypes bound_theta  -- Already zonked
-                        `unionVarSet` zonked_tau_tkvs
+                        `unionVarSet` tyCoVarsOfTypes zonked_taus
              promote_tkvs = closeOverKinds phi_tkvs `delVarSetList` qtvs
 
        ; MASSERT2( closeOverKinds promote_tkvs `subVarSet` promote_tkvs
@@ -651,7 +652,10 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
            -- Emit an implication constraint for the
            -- remaining constraints from the RHS
        ; bound_theta_vars <- mapM TcM.newEvVar bound_theta
-       ; let skol_info   = InferSkol [ (name, mkSigmaTy [] bound_theta ty)
+       ; psig_theta_vars  <- mapM zonkId psig_theta_vars
+       ; let full_theta      = psig_theta      ++ bound_theta
+             full_theta_vars = psig_theta_vars ++ bound_theta_vars
+             skol_info   = InferSkol [ (name, mkSigmaTy [] full_theta ty)
                                      | (name, ty) <- name_taus ]
                         -- Don't add the quantified variables here, because
                         -- they are also bound in ic_skols and we want them
@@ -665,7 +669,7 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
              implic = Implic { ic_tclvl    = rhs_tclvl
                              , ic_skols    = extra_qtvs ++ qtvs
                              , ic_no_eqs   = False
-                             , ic_given    = bound_theta_vars
+                             , ic_given    = full_theta_vars
                              , ic_wanted   = wanted_transformed
                              , ic_status   = IC_Unsolved
                              , ic_binds    = Just ev_binds_var
@@ -676,40 +680,40 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds
          -- All done!
        ; traceTc "} simplifyInfer/produced residual implication for quantification" $
          vcat [ text "quant_pred_candidates =" <+> ppr quant_pred_candidates
-              , text "zonked_taus" <+> ppr zonked_taus
-              , text "zonked_tau_dvs=" <+> ppr zonked_tau_dvs
               , text "promote_tvs=" <+> ppr promote_tkvs
+              , text "psig_theta =" <+> ppr psig_theta
               , text "bound_theta =" <+> ppr bound_theta
+              , text "full_theta =" <+> ppr full_theta
               , text "qtvs =" <+> ppr qtvs
               , text "implic =" <+> ppr implic ]
 
-       ; return ( qtvs, bound_theta_vars, TcEvBinds ev_binds_var ) }
-
-mkSigDerivedWanteds :: TcIdSigInfo -> TcM [Ct]
--- See Note [Add deriveds for signature contexts]
-mkSigDerivedWanteds (TISI { sig_bndr = PartialSig { sig_name = name }
-                          , sig_theta = theta, sig_tau = tau })
- = do { let skol_info = InferSkol [(name, mkSigmaTy [] theta tau)]
-      ; loc <- getCtLocM (GivenOrigin skol_info) (Just TypeLevel)
-      ; return [ mkNonCanonical (CtDerived { ctev_pred = pred
-                                           , ctev_loc = loc })
-               | pred <- theta ] }
-mkSigDerivedWanteds _ = return []
-
-{- Note [Add deriveds for signature contexts]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+       ; return ( qtvs, full_theta_vars, TcEvBinds ev_binds_var ) }
+
+{- Note [Add signature contexts as givens]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this (Trac #11016):
   f2 :: (?x :: Int) => _
   f2 = ?x
-We'll use plan InferGen because there are holes in the type.  But we want
-to have the (?x :: Int) constraint floating around so that the functional
-dependencies kick in.  Otherwise the occurrence of ?x on the RHS produces
-constraint (?x :: alpha), and we wont unify alpha:=Int.
+or this
+  f3 :: a ~ Bool => (a, _)
+  f3 = (True, False)
+or theis
+  f4 :: (Ord a, _) => a -> Bool
+  f4 x = x==x
+
+We'll use plan InferGen because there are holes in the type.  But:
+ * For f2 we want to have the (?x :: Int) constraint floating around
+   so that the functional dependencies kick in.  Otherwise the
+   occurrence of ?x on the RHS produces constraint (?x :: alpha), and
+   we won't unify alpha:=Int.
+ * For f3 we want the (a ~ Bool) available to solve the wanted (a ~ Bool)
+   in the RHS
+ * For f4 we want to use the (Ord a) in the signature to solve the Eq a
+   constraint.
 
 Solution: in simplifyInfer, just before simplifying the constraints
-gathered from the RHS, add Derived constraints for the context of any
-type signatures.  This is rare; if there is a type signature we'll usually
-be doing CheckGen.  But it happens for signatures with holes.
+gathered from the RHS, add Given constraints for the context of any
+type signatures.
 
 ************************************************************************
 *                                                                      *
@@ -746,22 +750,23 @@ including all covars -- and the quantified constraints are empty/insoluble.
 
 decideQuantification
   :: Bool                  -- try the MR restriction?
-  -> [Name]                -- variables to be generalised (for errors only)
+  -> [(Name, TcTauType)]   -- Variables to be generalised
   -> [PredType]            -- All annotated constraints from signatures
   -> [PredType]            -- Candidate theta
-  -> TcDepVars
   -> TcM ( [TcTyVar]       -- Quantify over these (skolems)
          , [PredType] )    -- and this context (fully zonked)
 -- See Note [Deciding quantification]
-decideQuantification apply_mr bndrs ann_theta constraints
-                     zonked_dvs@(DV { dv_kvs = zonked_tau_kvs, dv_tvs = zonked_tau_tvs })
+decideQuantification apply_mr name_taus psig_theta constraints
   | apply_mr     -- Apply the Monomorphism restriction
   = do { gbl_tvs <- tcGetGlobalTyCoVars
-       ; let zonked_tkvs = dVarSetToVarSet zonked_tau_kvs `unionVarSet`
-                           dVarSetToVarSet zonked_tau_tvs
+       ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus)
+                        -- psig_theta: see Note [Quantification and partial signatures]
+       ; let zonked_dvs      = splitDepVarsOfTypes zonked_taus
+             zonked_tkvs     = tcDepVarSet zonked_dvs
              constrained_tvs = tyCoVarsOfTypes constraints `unionVarSet`
                                filterVarSet isCoVar zonked_tkvs
              mono_tvs = gbl_tvs `unionVarSet` constrained_tvs
+
        ; qtvs <- quantifyZonkedTyVars mono_tvs zonked_dvs
 
            -- Warn about the monomorphism restriction
@@ -781,9 +786,12 @@ decideQuantification apply_mr bndrs ann_theta constraints
 
   | otherwise
   = do { gbl_tvs <- tcGetGlobalTyCoVars
-       ; let mono_tvs     = growThetaTyVars equality_constraints gbl_tvs
-             tau_tvs_plus = growThetaTyVarsDSet constraints zonked_tau_tvs
-             dvs_plus     = DV { dv_kvs = zonked_tau_kvs, dv_tvs = tau_tvs_plus }
+       ; zonked_taus <- mapM TcM.zonkTcType (psig_theta ++ taus)
+                        -- psig_theta: see Note [Quantification and partial signatures]
+       ; let DV { dv_kvs = zkvs, dv_tvs = ztvs} = splitDepVarsOfTypes zonked_taus
+             mono_tvs     = growThetaTyVars equality_constraints gbl_tvs
+             tau_tvs_plus = growThetaTyVarsDSet constraints ztvs
+             dvs_plus     = DV { dv_kvs = zkvs, dv_tvs = tau_tvs_plus }
        ; qtvs <- quantifyZonkedTyVars mono_tvs dvs_plus
           -- We don't grow the kvs, as there's no real need to. Recall
           -- that quantifyTyVars uses the separation between kvs and tvs
@@ -794,8 +802,8 @@ decideQuantification apply_mr bndrs ann_theta constraints
                  -- quantifyTyVars turned some meta tyvars into
                  -- quantified skolems, so we have to zonk again
 
-       ; let qtv_set = mkVarSet qtvs
-             theta   = pickQuantifiablePreds qtv_set ann_theta constraints
+       ; let qtv_set   = mkVarSet qtvs
+             theta     = pickQuantifiablePreds qtv_set constraints
              min_theta = mkMinimalBySCs theta
                -- See Note [Minimize by Superclasses]
 
@@ -803,7 +811,6 @@ decideQuantification apply_mr bndrs ann_theta constraints
            (vcat [ text "constraints:"  <+> ppr constraints
                  , text "gbl_tvs:"      <+> ppr gbl_tvs
                  , text "mono_tvs:"     <+> ppr mono_tvs
-                 , text "zonked_kvs:"   <+> ppr zonked_tau_kvs
                  , text "tau_tvs_plus:" <+> ppr tau_tvs_plus
                  , text "qtvs:"         <+> ppr qtvs
                  , text "min_theta:"    <+> ppr min_theta ])
@@ -811,6 +818,7 @@ decideQuantification apply_mr bndrs ann_theta constraints
   where
     pp_bndrs = pprWithCommas (quotes . ppr) bndrs
     equality_constraints = filter isEqPred constraints
+    (bndrs, taus) = unzip name_taus
 
 ------------------
 growThetaTyVars :: ThetaType -> TyCoVarSet -> TyVarSet

compiler/typecheck/TcType.hs

@@ -91,7 +91,7 @@ module TcType (
   ---------------------------------
   -- Predicate types
   mkMinimalBySCs, transSuperClasses,
-  pickQuantifiablePreds,
+  pickQuantifiablePreds, pickCapturedPreds,
   immSuperClasses,
   isImprovementPred,
 
@@ -100,7 +100,7 @@ module TcType (
 
   -- * Finding "exact" (non-dead) type variables
   exactTyCoVarsOfType, exactTyCoVarsOfTypes,
-  splitDepVarsOfType, splitDepVarsOfTypes, TcDepVars(..), depVarsTyVars,
+  splitDepVarsOfType, splitDepVarsOfTypes, TcDepVars(..), tcDepVarSet,
 
   -- * Extracting bound variables
   allBoundVariables, allBoundVariabless,
@@ -861,8 +861,10 @@ data TcDepVars  -- See Note [Dependent type variables]
          -- See Note [Dependent type variables]
     }
 
-depVarsTyVars :: TcDepVars -> DTyVarSet
-depVarsTyVars = dv_tvs
+tcDepVarSet :: TcDepVars -> TyVarSet
+-- Actually can contain CoVars, but never mind
+tcDepVarSet (DV { dv_kvs = kvs, dv_tvs = tvs })
+  = dVarSetToVarSet kvs `unionVarSet` dVarSetToVarSet tvs
 
 instance Monoid TcDepVars where
    mempty = DV { dv_kvs = emptyDVarSet, dv_tvs = emptyDVarSet }
@@ -1832,12 +1834,11 @@ evVarPred var
 -- [Inheriting implicit parameters] and [Quantifying over equality constraints]
 pickQuantifiablePreds
   :: TyVarSet           -- Quantifying over these
-  -> TcThetaType        -- Context from PartialTypeSignatures
   -> TcThetaType        -- Proposed constraints to quantify
   -> TcThetaType        -- A subset that we can actually quantify
 -- This function decides whether a particular constraint should be
 -- quantified over, given the type variables that are being quantified
-pickQuantifiablePreds qtvs annotated_theta theta
+pickQuantifiablePreds qtvs theta
   = let flex_ctxt = True in  -- Quantify over non-tyvar constraints, even without
                              -- -XFlexibleContexts: see Trac #10608, #10351
          -- flex_ctxt <- xoptM Opt_FlexibleContexts
@@ -1847,14 +1848,13 @@ pickQuantifiablePreds qtvs annotated_theta theta
       = case classifyPredType pred of
 
           ClassPred cls tys
-            | Just str <- isCallStackPred pred
-              -- NEVER infer a CallStack constraint, unless we were
-              -- given one in a partial type signatures.
+            | Just {} <- isCallStackPred pred
+              -- NEVER infer a CallStack constraint
               -- Otherwise, we let the constraints bubble up to be
               -- solved from the outer context, or be defaulted when we
               -- reach the top-level.
               -- see Note [Overview of implicit CallStacks]
-              -> str `elem` givenStks
+              -> False
 
             | isIPClass cls    -> True -- See note [Inheriting implicit parameters]
 
@@ -1867,9 +1867,6 @@ pickQuantifiablePreds qtvs annotated_theta theta
           EqPred NomEq ty1 ty2  -> quant_fun ty1 || quant_fun ty2
           IrredPred ty          -> tyCoVarsOfType ty `intersectsVarSet` qtvs
 
-    givenStks = [ str | (str, ty) <- mapMaybe isIPPred_maybe annotated_theta
-                      , isCallStackTy ty ]
-
     pick_cls_pred flex_ctxt cls tys
       = tyCoVarsOfTypes tys `intersectsVarSet` qtvs
         && (checkValidClsArgs flex_ctxt cls tys)
@@ -1883,6 +1880,19 @@ pickQuantifiablePreds qtvs annotated_theta theta
                          -> tyCoVarsOfTypes tys `intersectsVarSet` qtvs
           _ -> False
 
+pickCapturedPreds
+  :: TyVarSet           -- Quantifying over these
+  -> TcThetaType        -- Proposed constraints to quantify
+  -> TcThetaType        -- A subset that we can actually quantify
+-- A simpler version of pickQuantifiablePreds, used to winnow down
+-- the inferred constrains of a group of bindings, into those for
+-- one particular identifier
+pickCapturedPreds qtvs theta
+  = filter captured theta
+  where
+    captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs)
+
+
 -- Superclasses
 
 type PredWithSCs = (PredType, [PredType])

testsuite/tests/partial-sigs/should_compile/SuperCls.hs

+{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}
+module SuperCls where
+
+f :: (Ord a, _) => a -> Bool
+-- We'd like to see that the wildcard _ unifies with ()
+f x = x == x
+

testsuite/tests/partial-sigs/should_compile/SuperCls.stderr

+
+SuperCls.hs:4:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    Found constraint wildcard ‘_’ standing for ‘()’
+    In the type signature: f :: (Ord a, _) => a -> Bool

testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr

-TYPE SIGNATURES
-  bar :: forall t t1. t1 -> (t1 -> t) -> t
-  foo :: forall a. (Show a, Enum a) => a -> String
-TYPE CONSTRUCTORS
-COERCION AXIOMS
-Dependent modules: []
-Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
-                     integer-gmp-1.0.0.1]
-
-WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_a’ standing for ‘a’
-      Where: ‘a’ is a rigid type variable bound by
-               the inferred type of foo :: (Enum a, Show a) => a -> String
-               at WarningWildcardInstantiations.hs:6:1
-    • In the type signature: foo :: (Show _a, _) => _a -> _
-    • Relevant bindings include
-        foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1)
-
-WarningWildcardInstantiations.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    Found constraint wildcard ‘_’ standing for ‘Enum a’
-    In the type signature: foo :: (Show _a, _) => _a -> _
-
-WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘String’
-    • In the type signature: foo :: (Show _a, _) => _a -> _
-    • Relevant bindings include
-        foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1)
-
-WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘t1’
-      Where: ‘t1’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WarningWildcardInstantiations.hs:9:1
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WarningWildcardInstantiations.hs:9:1)
-
-WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘t1 -> t’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WarningWildcardInstantiations.hs:9:1
-             ‘t1’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WarningWildcardInstantiations.hs:9:1
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WarningWildcardInstantiations.hs:9:1)
-
-WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    • Found type wildcard ‘_’ standing for ‘t’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WarningWildcardInstantiations.hs:9:1
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WarningWildcardInstantiations.hs:9:1)
+TYPE SIGNATURES
+  bar :: forall t t1. t1 -> (t1 -> t) -> t
+  foo :: forall a. (Show a, Enum a) => a -> String
+TYPE CONSTRUCTORS
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
+                     integer-gmp-1.0.0.1]
+
+WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_a’ standing for ‘a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WarningWildcardInstantiations.hs:6:1
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+    • Relevant bindings include
+        foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1)
+
+WarningWildcardInstantiations.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    Found constraint wildcard ‘_’ standing for ‘Enum a’
+    In the type signature: foo :: (Show _a, _) => _a -> _
+
+WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘String’
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+    • Relevant bindings include
+        foo :: a -> String (bound at WarningWildcardInstantiations.hs:6:1)
+
+WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t1’
+      Where: ‘t1’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WarningWildcardInstantiations.hs:9:1
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WarningWildcardInstantiations.hs:9:1)
+
+WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t1 -> t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WarningWildcardInstantiations.hs:9:1
+             ‘t1’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WarningWildcardInstantiations.hs:9:1
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WarningWildcardInstantiations.hs:9:1)
+
+WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WarningWildcardInstantiations.hs:9:1
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WarningWildcardInstantiations.hs:9:1)

testsuite/tests/partial-sigs/should_compile/all.T

@@ -60,3 +60,4 @@ test('T10463', normal, compile, [''])
 test('ExprSigLocal', normal, compile, [''])
 test('T11016', normal, compile, [''])
 test('T11192', normal, compile, [''])
+test('SuperCls', normal, compile, [''])
\ No newline at end of file

testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr

-
-WildcardInstantiations.hs:5:14: error:
-    • Found type wildcard ‘_a’ standing for ‘a’
-      Where: ‘a’ is a rigid type variable bound by
-               the inferred type of foo :: (Enum a, Show a) => a -> String
-               at WildcardInstantiations.hs:6:1
-      To use the inferred type, enable PartialTypeSignatures
-    • In the type signature: foo :: (Show _a, _) => _a -> _
-    • Relevant bindings include
-        foo :: a -> String (bound at WildcardInstantiations.hs:6:1)
-
-WildcardInstantiations.hs:5:18: error:
-    Found constraint wildcard ‘_’ standing for ‘Enum a’
-    To use the inferred type, enable PartialTypeSignatures
-    In the type signature: foo :: (Show _a, _) => _a -> _
-
-WildcardInstantiations.hs:5:30: error:
-    • Found type wildcard ‘_’ standing for ‘String’
-      To use the inferred type, enable PartialTypeSignatures
-    • In the type signature: foo :: (Show _a, _) => _a -> _
-    • Relevant bindings include
-        foo :: a -> String (bound at WildcardInstantiations.hs:6:1)
-
-WildcardInstantiations.hs:8:8: error:
-    • Found type wildcard ‘_’ standing for ‘t1’
-      Where: ‘t1’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WildcardInstantiations.hs:9:1
-      To use the inferred type, enable PartialTypeSignatures
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WildcardInstantiations.hs:9:1)
-
-WildcardInstantiations.hs:8:13: error:
-    • Found type wildcard ‘_’ standing for ‘t1 -> t’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WildcardInstantiations.hs:9:1
-             ‘t1’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WildcardInstantiations.hs:9:1
-      To use the inferred type, enable PartialTypeSignatures
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WildcardInstantiations.hs:9:1)
-
-WildcardInstantiations.hs:8:18: error:
-    • Found type wildcard ‘_’ standing for ‘t’
-      Where: ‘t’ is a rigid type variable bound by
-               the inferred type of bar :: t1 -> (t1 -> t) -> t
-               at WildcardInstantiations.hs:9:1
-      To use the inferred type, enable PartialTypeSignatures
-    • In the type signature: bar :: _ -> _ -> _
-    • Relevant bindings include
-        bar :: t1 -> (t1 -> t) -> t
-          (bound at WildcardInstantiations.hs:9:1)
+
+WildcardInstantiations.hs:5:14: error:
+    • Found type wildcard ‘_a’ standing for ‘a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WildcardInstantiations.hs:6:1
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+    • Relevant bindings include
+        foo :: a -> String (bound at WildcardInstantiations.hs:6:1)
+
+WildcardInstantiations.hs:5:18: error:
+    Found constraint wildcard ‘_’ standing for ‘Enum a’
+    To use the inferred type, enable PartialTypeSignatures
+    In the type signature: foo :: (Show _a, _) => _a -> _
+
+WildcardInstantiations.hs:5:30: error:
+    • Found type wildcard ‘_’ standing for ‘String’
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+    • Relevant bindings include
+        foo :: a -> String (bound at WildcardInstantiations.hs:6:1)
+
+WildcardInstantiations.hs:8:8: error:
+    • Found type wildcard ‘_’ standing for ‘t1’
+      Where: ‘t1’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WildcardInstantiations.hs:9:1
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WildcardInstantiations.hs:9:1)
+
+WildcardInstantiations.hs:8:13: error:
+    • Found type wildcard ‘_’ standing for ‘t1 -> t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WildcardInstantiations.hs:9:1
+             ‘t1’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WildcardInstantiations.hs:9:1
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WildcardInstantiations.hs:9:1)
+
+WildcardInstantiations.hs:8:18: error:
+    • Found type wildcard ‘_’ standing for ‘t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t1 -> (t1 -> t) -> t
+               at WildcardInstantiations.hs:9:1
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
+    • Relevant bindings include
+        bar :: t1 -> (t1 -> t) -> t
+          (bound at WildcardInstantiations.hs:9:1)