Show explicit quantifiers in conflicting definitions error

This fixes #12441, where definitions in a Haskell module and its boot
file which differed only in their quantifiers produced a confusing error
message. Here we teach GHC to always show quantifiers for these errors.

Reviewers: goldfire, simonmar, erikd, austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: snowleopard, simonpj, mpickering, thomie

Differential Revision: https://phabricator.haskell.org/D2734

GHC Trac Issues: #12441

19 files changed, 235 insertions, 168 deletions

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index 4d7f8e3ef0..95d734ea5d 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -22,6 +22,7 @@ import GHCi.RemoteTypes
 import GhcMonad
 import HscTypes
 import Id
+import IfaceSyn ( showToHeader )
 import IfaceEnv( newInteractiveBinder )
 import Name
 import Var hiding ( varName )
@@ -214,7 +215,7 @@ pprTypeAndContents :: GhcMonad m => Id -> m SDoc
 pprTypeAndContents id = do
   dflags  <- GHC.getSessionDynFlags
   let pcontents = gopt Opt_PrintBindContents dflags
-      pprdId    = (PprTyThing.pprTyThing . AnId) id
+      pprdId    = (pprTyThing showToHeader . AnId) id
   if pcontents
     then do
       let depthBound = 100
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 4c95f90cbc..3d62e46bd4 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -35,7 +35,7 @@ module IfaceSyn (
         -- Pretty printing
         pprIfaceExpr,
         pprIfaceDecl,
-        ShowSub(..), ShowHowMuch(..)
+        AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader
     ) where
 
 #include "HsVersions.h"
@@ -572,7 +572,7 @@ instance HasOccName IfaceDecl where
   occName = getOccName
 
 instance Outputable IfaceDecl where
-  ppr = pprIfaceDecl showAll
+  ppr = pprIfaceDecl showToIface
 
 {-
 Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -583,28 +583,52 @@ filtering of method signatures. Instead we just check if anything at all is
 filtered and hide it in that case.
 -}
 
--- TODO: Kill this and Note [Printing IfaceDecl binders]
 data ShowSub
   = ShowSub
-      { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
-                                        -- See Note [Printing IfaceDecl binders]
-      , ss_how_much :: ShowHowMuch }
+      { ss_how_much :: ShowHowMuch
+      , ss_forall :: ShowForAllFlag }
+
+-- See Note [Printing IfaceDecl binders]
+-- The alternative pretty printer referred to in the note.
+newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))
 
 data ShowHowMuch
-  = ShowHeader   -- Header information only, not rhs
-  | ShowSome [OccName]    -- []     <=> Print all sub-components
-                          -- (n:ns) <=> print sub-component 'n' with ShowSub=ns
-                          --            elide other sub-components to "..."
-                          -- May 14: the list is max 1 element long at the moment
-  | ShowIface    -- Everything including GHC-internal information (used in --show-iface)
+  = ShowHeader AltPpr -- ^Header information only, not rhs
+  | ShowSome [OccName] AltPpr
+  -- ^ Show only some sub-components. Specifically,
+  --
+  -- [@[]@] Print all sub-components.
+  -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;
+  -- elide other sub-components to @...@
+  -- May 14: the list is max 1 element long at the moment
+  | ShowIface
+  -- ^Everything including GHC-internal information (used in --show-iface)
+
+{-
+Note [Printing IfaceDecl binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The binders in an IfaceDecl are just OccNames, so we don't know what module they
+come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
+(see PprTyThing), the TyThing may come from some other module so we really need
+the module qualifier.  We solve this by passing in a pretty-printer for the
+binders.
+
+When printing an interface file (--show-iface), we want to print
+everything unqualified, so we can just print the OccName directly.
+-}
 
 instance Outputable ShowHowMuch where
-  ppr ShowHeader      = text "ShowHeader"
-  ppr ShowIface       = text "ShowIface"
-  ppr (ShowSome occs) = text "ShowSome" <+> ppr occs
+  ppr (ShowHeader _)    = text "ShowHeader"
+  ppr ShowIface         = text "ShowIface"
+  ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs
+
+showToHeader :: ShowSub
+showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing
+                       , ss_forall = ShowForAllWhen }
 
-showAll :: ShowSub
-showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }
+showToIface :: ShowSub
+showToIface = ShowSub { ss_how_much = ShowIface
+                      , ss_forall = ShowForAllWhen }
 
 ppShowIface :: ShowSub -> SDoc -> SDoc
 ppShowIface (ShowSub { ss_how_much = ShowIface }) doc = doc
@@ -612,32 +636,19 @@ ppShowIface _                                     _   = Outputable.empty
 
 -- show if all sub-components or the complete interface is shown
 ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
-ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] }) doc = doc
-ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc
-ppShowAllSubs _                                      _   = Outputable.empty
+ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc
+ppShowAllSubs (ShowSub { ss_how_much = ShowIface })     doc = doc
+ppShowAllSubs _                                         _   = Outputable.empty
 
 ppShowRhs :: ShowSub -> SDoc -> SDoc
-ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
-ppShowRhs _                                      doc = doc
+ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _   = Outputable.empty
+ppShowRhs _                                        doc = doc
 
 showSub :: HasOccName n => ShowSub -> n -> Bool
-showSub (ShowSub { ss_how_much = ShowHeader })     _     = False
-showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
+showSub (ShowSub { ss_how_much = ShowHeader _ })     _     = False
+showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing
 showSub (ShowSub { ss_how_much = _ })              _     = True
 
-{-
-Note [Printing IfaceDecl binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The binders in an IfaceDecl are just OccNames, so we don't know what module they
-come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
-(see PprTyThing), the TyThing may come from some other module so we really need
-the module qualifier.  We solve this by passing in a pretty-printer for the
-binders.
-
-When printing an interface file (--show-iface), we want to print
-everything unqualified, so we can just print the OccName directly.
--}
-
 ppr_trim :: [Maybe SDoc] -> [SDoc]
 -- Collapse a group of Nothings to a single "..."
 ppr_trim xs
@@ -683,7 +694,9 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
     pp_roles
       | is_data_instance = empty
       | otherwise        = pprRoles (== Representational)
-                                    (pprPrefixIfDeclBndr ss (occName tycon))
+                                    (pprPrefixIfDeclBndr
+                                        (ss_how_much ss)
+                                        (occName tycon))
                                     binders roles
             -- Don't display roles for data family instances (yet)
             -- See discussion on Trac #8672.
@@ -714,7 +727,11 @@ pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs
                             , ifRoles = roles
                             , ifFDs    = fds, ifMinDef = minDef
                             , ifBinders = binders })
-  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss (occName clas)) binders roles
+  = vcat [ pprRoles
+             (== Nominal)
+             (pprPrefixIfDeclBndr (ss_how_much ss) (occName clas))
+             binders
+             roles
          , text "class" <+> pprIfaceDeclHead context ss clas binders Nothing
                                 <+> pprFundeps fds <+> pp_where
          , nest 2 (vcat [ vcat asocs, vcat dsigs
@@ -788,7 +805,11 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon
 
     pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
       = hang (text "where")
-           2 (vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss (occName tycon))) brs)
+           2 (vcat (map (pprAxBranch
+                           (pprPrefixIfDeclBndr
+                             (ss_how_much ss)
+                             (occName tycon))
+                        ) brs)
               $$ ppShowIface ss (text "axiom" <+> ppr ax))
     pp_branches _ = Outputable.empty
 
@@ -814,8 +835,8 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
 
 pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                               ifIdDetails = details, ifIdInfo = info })
-  = vcat [ hang (pprPrefixIfDeclBndr ss (occName var) <+> dcolon)
-              2 (pprIfaceSigmaType ty)
+  = vcat [ hang (pprPrefixIfDeclBndr (ss_how_much ss) (occName var) <+> dcolon)
+              2 (pprIfaceSigmaType (ss_forall ss) ty)
          , ppShowIface ss (ppr details)
          , ppShowIface ss (ppr info) ]
 
@@ -839,14 +860,22 @@ pprRoles suppress_if tyCon bndrs roles
       in ppUnless (all suppress_if roles || null froles) $
          text "type role" <+> tyCon <+> hsep (map ppr froles)
 
-pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
-pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
+pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
+pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
   = pprInfixVar (isSymOcc name) (ppr_bndr name)
-pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) name
+pprInfixIfDeclBndr _ name
+  = pprInfixVar (isSymOcc name) (ppr name)
+
+pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
+pprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr))) name
   = parenSymOcc name (ppr_bndr name)
+pprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr))) name
+  = parenSymOcc name (ppr_bndr name)
+pprPrefixIfDeclBndr _ name
+  = parenSymOcc name (ppr name)
 
 instance Outputable IfaceClassOp where
-   ppr = pprIfaceClassOp showAll
+   ppr = pprIfaceClassOp showToIface
 
 pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
 pprIfaceClassOp ss (IfaceClassOp n ty dm)
@@ -856,10 +885,13 @@ pprIfaceClassOp ss (IfaceClassOp n ty dm)
               =  text "default" <+> pp_sig n dm_ty
               | otherwise
               = empty
-   pp_sig n ty = pprPrefixIfDeclBndr ss (occName n) <+> dcolon <+> pprIfaceSigmaType ty
+   pp_sig n ty
+     = pprPrefixIfDeclBndr (ss_how_much ss) (occName n)
+     <+> dcolon
+     <+> pprIfaceSigmaType ShowForAllWhen ty
 
 instance Outputable IfaceAT where
-   ppr = pprIfaceAT showAll
+   ppr = pprIfaceAT showToIface
 
 pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
 pprIfaceAT ss (IfaceAT d mb_def)
@@ -887,7 +919,7 @@ pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
 pprIfaceDeclHead context ss tc_occ bndrs m_res_kind
   = sdocWithDynFlags $ \ dflags ->
     sep [ pprIfaceContextArr context
-        , pprPrefixIfDeclBndr ss (occName tc_occ)
+        , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)
           <+> pprIfaceTyConBinders (suppressIfaceInvisibles dflags bndrs bndrs)
         , maybe empty (\res_kind -> dcolon <+> pprIfaceType res_kind) m_res_kind ]
 
@@ -911,12 +943,16 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
   | gadt_style            = pp_prefix_con <+> dcolon <+> ppr_ty
   | not (null fields)     = pp_prefix_con <+> pp_field_args
   | is_infix
-  , [ty1, ty2] <- pp_args = sep [ty1, pprInfixIfDeclBndr ss (occName name), ty2]
+  , [ty1, ty2] <- pp_args = sep [ ty1
+                                , pprInfixIfDeclBndr how_much (occName name)
+                                , ty2]
+
   | otherwise             = pp_prefix_con <+> sep pp_args
   where
+    how_much = ss_how_much ss
     tys_w_strs :: [(IfaceBang, IfaceType)]
     tys_w_strs = zip stricts arg_tys
-    pp_prefix_con = pprPrefixIfDeclBndr ss (occName name)
+    pp_prefix_con = pprPrefixIfDeclBndr how_much (occName name)
 
     (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
     ppr_ty = pprIfaceForAllPart (map tv_to_forall_bndr univ_tvs ++ ex_tvs)
@@ -949,8 +985,10 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
 
     maybe_show_label :: IfaceTopBndr -> (IfaceBang, IfaceType) -> Maybe SDoc
     maybe_show_label sel bty
-      | showSub ss sel = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
-      | otherwise      = Nothing
+      | showSub ss sel =
+          Just (pprPrefixIfDeclBndr how_much lbl <+> dcolon <+> pprBangTy bty)
+      | otherwise      =
+          Nothing
       where
         -- IfaceConDecl contains the name of the selector function, so
         -- we have to look up the field label (in case
@@ -971,7 +1009,7 @@ pprIfaceConDecl ss gadt_style fls tycon tc_binders parent
         con_univ_tvs = filterOut done_univ_tv (map ifTyConBinderTyVar tc_binders)
 
     ppr_tc_app gadt_subst dflags
-       = pprPrefixIfDeclBndr ss (occName tycon)
+       = pprPrefixIfDeclBndr how_much (occName tycon)
          <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
                  | (tv,_kind)
                      <- map ifTyConBinderTyVar $
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index ad1a3ea0c4..47f284e54f 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -18,7 +18,7 @@ module IfaceType (
         IfaceTyLit(..), IfaceTcArgs(..),
         IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
         IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
-        IfaceForAllBndr, ArgFlag(..),
+        IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
 
         ifTyConBinderTyVar, ifTyConBinderName,
 
@@ -719,7 +719,7 @@ ppr_ty ctxt_prec (IfaceCoercionTy co)
       (text "<>")
 
 ppr_ty ctxt_prec ty
-  = maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True ty)
+  = maybeParen ctxt_prec FunPrec (pprIfaceSigmaType ShowForAllMust ty)
 
 {-
 Note [Defaulting RuntimeRep variables]
@@ -827,26 +827,20 @@ ppr_tc_args ctx_prec args
         ITC_Invis t ts -> pprTys t ts
 
 -------------------
-ppr_iface_sigma_type :: Bool -> IfaceType -> SDoc
-ppr_iface_sigma_type show_foralls_unconditionally ty
-  = ppr_iface_forall_part show_foralls_unconditionally tvs theta (ppr tau)
-  where
-    (tvs, theta, tau) = splitIfaceSigmaTy ty
-
--------------------
 pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
-pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
+pprIfaceForAllPart tvs ctxt sdoc
+  = ppr_iface_forall_part ShowForAllWhen tvs ctxt sdoc
 
 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
-pprIfaceForAllCoPart tvs sdoc =
-    sep [ pprIfaceForAllCo tvs, sdoc ]
+pprIfaceForAllCoPart tvs sdoc
+  = sep [ pprIfaceForAllCo tvs, sdoc ]
 
-ppr_iface_forall_part :: Bool
+ppr_iface_forall_part :: ShowForAllFlag
                       -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
-ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
-  = sep [ if show_foralls_unconditionally
-          then pprIfaceForAll tvs
-          else pprUserIfaceForAll tvs
+ppr_iface_forall_part show_forall tvs ctxt sdoc
+  = sep [ case show_forall of
+            ShowForAllMust -> pprIfaceForAll tvs
+            ShowForAllWhen -> pprUserIfaceForAll tvs
         , pprIfaceContextArr ctxt
         , sdoc]
 
@@ -893,8 +887,18 @@ pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
 pprIfaceForAllCoBndr (tv, kind_co)
   = parens (ppr tv <+> dcolon <+> pprIfaceCoercion kind_co)
 
-pprIfaceSigmaType :: IfaceType -> SDoc
-pprIfaceSigmaType ty = ppr_iface_sigma_type False ty
+-- | Show forall flag
+--
+-- Unconditionally show the forall quantifier with ('ShowForAllMust')
+-- or when ('ShowForAllWhen') the names used are free in the binder
+-- or when compiling with -fprint-explicit-foralls.
+data ShowForAllFlag = ShowForAllMust | ShowForAllWhen
+
+pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
+pprIfaceSigmaType show_forall ty
+  = ppr_iface_forall_part show_forall tvs theta (ppr tau)
+  where
+    (tvs, theta, tau) = splitIfaceSigmaTy ty
 
 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprUserIfaceForAll tvs
diff --git a/compiler/iface/IfaceType.hs-boot b/compiler/iface/IfaceType.hs-boot
index a030c553f6..2a5331e5c2 100644
--- a/compiler/iface/IfaceType.hs-boot
+++ b/compiler/iface/IfaceType.hs-boot
@@ -11,6 +11,7 @@ type IfLclName = FastString
 type IfaceKind = IfaceType
 type IfacePredType = IfaceType
 
+data ShowForAllFlag
 data IfaceType
 data IfaceTyCon
 data IfaceTyLit
@@ -23,7 +24,7 @@ type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
 instance Outputable IfaceType
 
 pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
-pprIfaceSigmaType :: IfaceType -> SDoc
+pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
 pprIfaceTyLit :: IfaceTyLit -> SDoc
 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 3b44bb1fda..3a429c02b0 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1890,7 +1890,7 @@ isImplicitTyThing (ATyCon tc)   = isImplicitTyCon tc
 isImplicitTyThing (ACoAxiom ax) = isImplicitCoAxiom ax
 
 -- | tyThingParent_maybe x returns (Just p)
--- when pprTyThingInContext sould print a declaration for p
+-- when pprTyThingInContext should print a declaration for p
 -- (albeit with some "..." in it) when asked to show x
 -- It returns the *immediate* parent.  So a datacon returns its tycon
 -- but the tycon could be the associated type of a class, so it in turn
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index c02dd2350a..86098a5e7f 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -20,12 +20,13 @@ module PprTyThing (
 #include "HsVersions.h"
 
 import Type    ( TyThing(..) )
+import IfaceSyn ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
+  , showToHeader, pprIfaceDecl )
 import CoAxiom ( coAxiomTyCon )
 import HscTypes( tyThingParent_maybe )
 import MkIface ( tyThingToIfaceDecl )
 import Type ( tidyOpenType )
-import IfaceSyn ( pprIfaceDecl, ShowSub(..), ShowHowMuch(..) )
-import FamInstEnv( FamInst( .. ), FamFlavor(..) )
+import FamInstEnv( FamInst(..), FamFlavor(..) )
 import Type( Type, pprTypeApp, pprSigmaType )
 import Name
 import VarEnv( emptyTidyEnv )
@@ -94,56 +95,62 @@ pprFamInst (FamInst { fi_flavor = SynFamilyInst, fi_axiom = axiom
 -- | Pretty-prints a 'TyThing' with its defining location.
 pprTyThingLoc :: TyThing -> SDoc
 pprTyThingLoc tyThing
-  = showWithLoc (pprDefinedAt (getName tyThing)) (pprTyThing tyThing)
-
--- | Pretty-prints a 'TyThing'.
-pprTyThing :: TyThing -> SDoc
-pprTyThing = ppr_ty_thing False []
+  = showWithLoc (pprDefinedAt (getName tyThing))
+                (pprTyThing showToHeader tyThing)
 
 -- | Pretty-prints the 'TyThing' header. For functions and data constructors
 -- the function is equivalent to 'pprTyThing' but for type constructors
 -- and classes it prints only the header part of the declaration.
 pprTyThingHdr :: TyThing -> SDoc
-pprTyThingHdr = ppr_ty_thing True []
+pprTyThingHdr = pprTyThing showToHeader
 
 -- | Pretty-prints a 'TyThing' in context: that is, if the entity
 -- is a data constructor, record selector, or class method, then
 -- the entity's parent declaration is pretty-printed with irrelevant
 -- parts omitted.
-pprTyThingInContext :: TyThing -> SDoc
-pprTyThingInContext thing
+pprTyThingInContext :: ShowSub -> TyThing -> SDoc
+pprTyThingInContext show_sub thing
   = go [] thing
   where
-    go ss thing = case tyThingParent_maybe thing of
-                    Just parent -> go (getOccName thing : ss) parent
-                    Nothing     -> ppr_ty_thing False ss thing
+    go ss thing
+      = case tyThingParent_maybe thing of
+          Just parent ->
+            go (getOccName thing : ss) parent
+          Nothing ->
+            pprTyThing
+              (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) })
+              thing
 
 -- | Like 'pprTyThingInContext', but adds the defining location.
 pprTyThingInContextLoc :: TyThing -> SDoc
 pprTyThingInContextLoc tyThing
   = showWithLoc (pprDefinedAt (getName tyThing))
-                (pprTyThingInContext tyThing)
+                (pprTyThingInContext showToHeader tyThing)
 
-------------------------
-ppr_ty_thing :: Bool -> [OccName] -> TyThing -> SDoc
+-- | Pretty-prints a 'TyThing'.
+pprTyThing :: ShowSub -> TyThing -> SDoc
 -- We pretty-print 'TyThing' via 'IfaceDecl'
 -- See Note [Pretty-printing TyThings]
-ppr_ty_thing hdr_only path ty_thing
-  = pprIfaceDecl ss (tyThingToIfaceDecl ty_thing)
+pprTyThing ss ty_thing
+  = pprIfaceDecl ss' (tyThingToIfaceDecl ty_thing)
   where
-    ss = ShowSub { ss_how_much = how_much, ss_ppr_bndr = ppr_bndr }
-    how_much | hdr_only  = ShowHeader
-             | otherwise = ShowSome path
-    name    = getName ty_thing
-    ppr_bndr :: OccName -> SDoc
-    ppr_bndr | isBuiltInSyntax name
-             = ppr
-             | otherwise
-             = case nameModule_maybe name of
-                 Just mod -> \ occ -> getPprStyle $ \sty ->
-                                      pprModulePrefix sty mod occ <> ppr occ
-                 Nothing  -> WARN( True, ppr name ) ppr
-                 -- Nothing is unexpected here; TyThings have External names
+    ss' = case ss_how_much ss of
+      ShowHeader (AltPpr Nothing)  -> ss { ss_how_much = ShowHeader ppr' }
+      ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' }
+      _                   -> ss
+
+    ppr' = AltPpr $ ppr_bndr $ getName ty_thing
+
+    ppr_bndr :: Name -> Maybe (OccName -> SDoc)
+    ppr_bndr name
+      | isBuiltInSyntax name
+         = Nothing
+      | otherwise
+         = case nameModule_maybe name of
+             Just mod -> Just $ \occ -> getPprStyle $ \sty ->
+               pprModulePrefix sty mod occ <> ppr occ
+             Nothing  -> WARN( True, ppr name ) Nothing
+             -- Nothing is unexpected here; TyThings have External names
 
 pprTypeForUser :: Type -> SDoc
 -- The type is tidied
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 13c838260d..2d35e96851 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -59,6 +59,8 @@ import Plugins ( tcPlugin )
 import DynFlags
 import StaticFlags
 import HsSyn
+import IfaceSyn ( ShowSub(..), showToHeader )
+import IfaceType( ShowForAllFlag(..) )
 import PrelNames
 import RdrName
 import TcHsSyn
@@ -67,7 +69,7 @@ import TcRnMonad
 import TcRnExports
 import TcEvidence
 import qualified BooleanFormula as BF
-import PprTyThing( pprTyThing )
+import PprTyThing( pprTyThingInContext )
 import MkIface( tyThingToIfaceDecl )
 import Coercion( pprCoAxiom )
 import CoreFVs( orphNamesOfFamInst )
@@ -1177,17 +1179,33 @@ badReexportedBootThing is_boot name name'
 
 bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> SDoc
 bootMisMatch is_boot extra_info real_thing boot_thing
-  = vcat [ppr real_thing <+>
-          text "has conflicting definitions in the module",
-          text "and its" <+>
-            (if is_boot then text "hs-boot file"
-                       else text "hsig file"),
-          text "Main module:" <+> PprTyThing.pprTyThing real_thing,
-          (if is_boot
-            then text "Boot file:  "
-            else text "Hsig file: ")
-            <+> PprTyThing.pprTyThing boot_thing,
-          extra_info]
+  = pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc
+  where
+    to_doc
+      = pprTyThingInContext $ showToHeader { ss_forall =
+                                              if is_boot
+                                                then ShowForAllMust
+                                                else ShowForAllWhen }
+
+    real_doc = to_doc real_thing
+    boot_doc = to_doc boot_thing
+
+    pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc
+    pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc
+      = vcat
+          [ ppr real_thing <+>
+            text "has conflicting definitions in the module",
+            text "and its" <+>
+              (if is_boot
+                then text "hs-boot file"
+                else text "hsig file"),
+            text "Main module:" <+> real_doc,
+              (if is_boot
+                then text "Boot file:  "
+                else text "Hsig file: ")
+                <+> boot_doc,
+            extra_info
+          ]
 
 instMisMatch :: Bool -> ClsInst -> SDoc
 instMisMatch is_boot inst
@@ -2492,7 +2510,7 @@ ppr_tydecls tycons
   = vcat [ ppr (tyThingToIfaceDecl (ATyCon tc))
          | tc <- sortBy (comparing getOccName) tycons ]
     -- The Outputable instance for IfaceDecl uses
-    -- showAll, which is what we want here, whereas
+    -- showToIface, which is what we want here, whereas
     -- pprTyThing uses ShowSome.
 
 {-
@@ -2533,4 +2551,3 @@ loadTcPlugins hsc_env =
   where
     load_plugin (_, plug, opts) = tcPlugin plug opts
 #endif
-
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index a8e074caf4..22345ec50d 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -2475,7 +2475,7 @@ instance Outputable TyLit where
 ------------------
 
 pprSigmaType :: Type -> SDoc
-pprSigmaType = pprIfaceSigmaType . tidyToIfaceType
+pprSigmaType = (pprIfaceSigmaType ShowForAllWhen) . tidyToIfaceType
 
 pprForAll :: [TyVarBinder] -> SDoc
 pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 29f423869d..18d72dfa0e 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -56,6 +56,7 @@ import Module
 import Name
 import Packages ( trusted, getPackageDetails, getInstalledPackageDetails,
                   listVisibleModuleNames, pprFlag )
+import IfaceSyn ( showToHeader )
 import PprTyThing
 import PrelNames
 import RdrName ( RdrName, getGRE_NameQualifier_maybes, getRdrName )
@@ -2135,8 +2136,8 @@ browseModule bang modl exports_only = do
 
         let things | bang      = catMaybes mb_things
                    | otherwise = filtered_things
-            pretty | bang      = pprTyThing
-                   | otherwise = pprTyThingInContext
+            pretty | bang      = pprTyThing showToHeader
+                   | otherwise = pprTyThingInContext showToHeader
 
             labels  [] = text "-- not currently imported"
             labels  l  = text $ intercalate "\n" $ map qualifier l
@@ -2830,7 +2831,7 @@ showBindings = do
 
     pprTT :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst]) -> SDoc
     pprTT (thing, fixity, _cls_insts, _fam_insts)
-      = pprTyThing thing
+      = pprTyThing showToHeader thing
         $$ show_fixity
       where
         show_fixity
@@ -2839,7 +2840,7 @@ showBindings = do
 
 
 printTyThing :: TyThing -> GHCi ()
-printTyThing tyth = printForUser (pprTyThing tyth)
+printTyThing tyth = printForUser (pprTyThing showToHeader tyth)
 
 showBkptTable :: GHCi ()
 showBkptTable = do
diff --git a/testsuite/tests/codeGen/should_run/T12855.hs b/testsuite/tests/codeGen/should_run/T12855.hs
index 6cc9f2f75b..0561995f8b 100644
--- a/testsuite/tests/codeGen/should_run/T12855.hs
+++ b/testsuite/tests/codeGen/should_run/T12855.hs
@@ -6,4 +6,3 @@ import qualified Data.ByteString.Char8 as S8
 
 main :: IO ()
 main = (S8.concat (map S.singleton (S.unpack (S8.pack "<foo>"))) == S8.empty) `seq` return ()
-
diff --git a/testsuite/tests/ghci/scripts/T11051b.stdout b/testsuite/tests/ghci/scripts/T11051b.stdout
index 7eb3f08217..613bf15c3a 100644
--- a/testsuite/tests/ghci/scripts/T11051b.stdout
+++ b/testsuite/tests/ghci/scripts/T11051b.stdout
@@ -1 +1 @@
-data Hello = Hello Int
+data Hello = ...
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index dd3a757b80..d660d233cd 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -4,21 +4,15 @@
 T.length :: T.Integer
 class N a
 class S a
-class C a b where
-  c1 :: N b => a -> b
-  c2 :: (N b, S b) => a -> b
-  c3 :: a1 -> b
-  c4 :: a1 -> b
-  {-# MINIMAL c1, c2, c3, c4 #-}
+class C a b
+  ...
 c1 :: (C a b, N b) => a -> b
 c2 :: (C a b, N b, S b) => a -> b
 c3 :: C a b => forall a. a -> b
 c4 :: C a b => forall a1. a1 -> b
 -- imported via Control.Monad
-class (GHC.Base.Alternative m, Monad m) =>
-      MonadPlus (m :: * -> *) where
-  mzero :: m a
-  mplus :: m a -> m a -> m a
+class (GHC.Base.Alternative m, Monad m) => MonadPlus (m :: * -> *)
+  ...
 mplus :: MonadPlus m => forall a. m a -> m a -> m a
 mzero :: MonadPlus m => forall a. m a
 -- imported via Control.Monad, Prelude
@@ -27,12 +21,8 @@ mzero :: MonadPlus m => forall a. m a
 fail :: Monad m => forall a. GHC.Base.String -> m a
 return :: Monad m => forall a. a -> m a
 -- imported via Control.Monad, Prelude, T
-class GHC.Base.Applicative m => Monad (m :: * -> *) where
-  (>>=) :: m a -> (a -> m b) -> m b
-  (>>) :: m a -> m b -> m b
-  return :: a -> m a
-  fail :: GHC.Base.String -> m a
-  {-# MINIMAL (>>=) #-}
+class GHC.Base.Applicative m => Monad (m :: * -> *)
+  ...
 -- imported via Data.Maybe
 catMaybes :: [Maybe a] -> [a]
 fromJust :: Maybe a -> a
@@ -45,35 +35,26 @@ maybe :: b -> (a -> b) -> Maybe a -> b
 maybeToList :: Maybe a -> [a]
 -- imported via Data.Maybe, Prelude
 Just :: a -> Maybe a
-data Maybe a = Nothing | Just a
+data Maybe a = ...
 Nothing :: Maybe a
 -- imported via Prelude
 (+) :: GHC.Num.Num a => a -> a -> a
 (=<<) :: Monad m => (a -> m b) -> m a -> m b
-class Eq a where
-  (GHC.Classes.==) :: a -> a -> GHC.Types.Bool
-  (GHC.Classes./=) :: a -> a -> GHC.Types.Bool
-  {-# MINIMAL (==) | (/=) #-}
+class Eq a
+  ...
 -- imported via Prelude, T
 Prelude.length ::
   Data.Foldable.Foldable t => forall a. t a -> GHC.Types.Int
 -- imported via T
-data T.Integer
-  = integer-gmp-1.0.0.1:GHC.Integer.Type.S# !GHC.Prim.Int#
-  | integer-gmp-1.0.0.1:GHC.Integer.Type.Jp# {-# UNPACK #-}integer-gmp-1.0.0.1:GHC.Integer.Type.BigNat
-  | integer-gmp-1.0.0.1:GHC.Integer.Type.Jn# {-# UNPACK #-}integer-gmp-1.0.0.1:GHC.Integer.Type.BigNat
+data T.Integer = ...
 T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int
 :browse! T
 -- defined locally
 T.length :: T.Integer
 class N a
 class S a
-class C a b where
-  c1 :: N b => a -> b
-  c2 :: (N b, S b) => a -> b
-  c3 :: a1 -> b
-  c4 :: a1 -> b
-  {-# MINIMAL c1, c2, c3, c4 #-}
+class C a b
+  ...
 c1 :: (C a b, N b) => a -> b
 c2 :: (C a b, N b, S b) => a -> b
 c3 :: C a b => forall a. a -> b
@@ -83,12 +64,8 @@ c4 :: C a b => forall a1. a1 -> b
 T.length :: T.Integer
 class N a
 class S a
-class C a b where
-  c1 :: N b => a -> b
-  c2 :: (N b, S b) => a -> b
-  c3 :: forall a1. a1 -> b
-  c4 :: forall a1. a1 -> b
-  {-# MINIMAL c1, c2, c3, c4 #-}
+class C a b
+  ...
 c1 :: forall a b. (C a b, N b) => a -> b
 c2 :: forall a b. (C a b, N b, S b) => a -> b
 c3 :: forall a b. C a b => forall a. a -> b
@@ -117,3 +94,4 @@ Ghci025C.g :: forall {a}. Num a => a -> a
 Ghci025C.h :: forall {a}. Integral a => a -> a
 -- defined locally
 f :: forall {a}. Num a => a -> a
+
diff --git a/testsuite/tests/partial-sigs/should_compile/T12844.hs b/testsuite/tests/partial-sigs/should_compile/T12844.hs
index d47b82cc64..77c6c2a87c 100644
--- a/testsuite/tests/partial-sigs/should_compile/T12844.hs
+++ b/testsuite/tests/partial-sigs/should_compile/T12844.hs
@@ -17,4 +17,3 @@ data FooData rngs
 class Foo xs where foo :: (Head xs ~ '(r,r')) => FooData xs
 
 type family Head (xs :: [k]) where Head (x ': xs) = x
-
diff --git a/testsuite/tests/typecheck/T12441/T12441.hs b/testsuite/tests/typecheck/T12441/T12441.hs
new file mode 100644
index 0000000000..5b3aeab87b
--- /dev/null
+++ b/testsuite/tests/typecheck/T12441/T12441.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module T12441 where
+import T12441A
+f :: forall b a. (a, b)
+f = undefined
diff --git a/testsuite/tests/typecheck/T12441/T12441.hs-boot b/testsuite/tests/typecheck/T12441/T12441.hs-boot
new file mode 100644
index 0000000000..c02e05a90c
--- /dev/null
+++ b/testsuite/tests/typecheck/T12441/T12441.hs-boot
@@ -0,0 +1,3 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module T12441 where
+f :: forall a b. (a, b)
diff --git a/testsuite/tests/typecheck/T12441/T12441.stderr b/testsuite/tests/typecheck/T12441/T12441.stderr
new file mode 100644
index 0000000000..fe6b471d52
--- /dev/null
+++ b/testsuite/tests/typecheck/T12441/T12441.stderr
@@ -0,0 +1,10 @@
+[1 of 3] Compiling T12441[boot]     ( T12441.hs-boot, T12441.o-boot )

+[2 of 3] Compiling T12441A          ( T12441A.hs, T12441A.o ) 

+[3 of 3] Compiling T12441           ( T12441.hs, T12441.o )

+

+T12441.hs-boot:3:1:

+    Identifier ‘f’ has conflicting definitions in the module

+    and its hs-boot file

+    Main module: f :: forall b a. (a, b)

+    Boot file:   f :: forall a b. (a, b)

+    The two types are different

diff --git a/testsuite/tests/typecheck/T12441/T12441A.hs b/testsuite/tests/typecheck/T12441/T12441A.hs
new file mode 100644
index 0000000000..cb6be4f144
--- /dev/null
+++ b/testsuite/tests/typecheck/T12441/T12441A.hs
@@ -0,0 +1,2 @@
+module T12441A where
+import {-# SOURCE #-} T12441
diff --git a/testsuite/tests/typecheck/T12441/all.T b/testsuite/tests/typecheck/T12441/all.T
new file mode 100644
index 0000000000..09b1b3e1c1
--- /dev/null
+++ b/testsuite/tests/typecheck/T12441/all.T
@@ -0,0 +1,4 @@
+test('T12441',
+     [],
+     multimod_compile_fail,
+     ['T12441', '-fforce-recomp'])
diff --git a/testsuite/tests/typecheck/should_compile/Improvement.hs b/testsuite/tests/typecheck/should_compile/Improvement.hs
index 8df81c26a7..b7bda66813 100644
--- a/testsuite/tests/typecheck/should_compile/Improvement.hs
+++ b/testsuite/tests/typecheck/should_compile/Improvement.hs
@@ -24,5 +24,3 @@ blug = error "Urk"
 
 foo :: Bool
 foo = blug undefined
-
-