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

8 files changed, 190 insertions, 122 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)