Fix #18052 by using pprPrefixOcc in more places

This fixes several small oversights in the choice of pretty-printing
function to use. Fixes #18052.

2 files changed, 13 insertions, 9 deletions

diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index df12815e6c..df88351df2 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -123,11 +123,13 @@ ppr_binding ann (val_bdr, expr)
          , pp_bind
          ]
   where
+    pp_val_bdr = pprPrefixOcc val_bdr
+
     pp_bind = case bndrIsJoin_maybe val_bdr of
                 Nothing -> pp_normal_bind
                 Just ar -> pp_join_bind ar
 
-    pp_normal_bind = hang (ppr val_bdr) 2 (equals <+> pprCoreExpr expr)
+    pp_normal_bind = hang pp_val_bdr 2 (equals <+> pprCoreExpr expr)
 
       -- For a join point of join arity n, we want to print j = \x1 ... xn -> e
       -- as "j x1 ... xn = e" to differentiate when a join point returns a
@@ -135,7 +137,7 @@ ppr_binding ann (val_bdr, expr)
       -- an n-argument function).
     pp_join_bind join_arity
       | bndrs `lengthAtLeast` join_arity
-      = hang (ppr val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs))
+      = hang (pp_val_bdr <+> sep (map (pprBndr LambdaBind) lhs_bndrs))
            2 (equals <+> pprCoreExpr rhs)
       | otherwise -- Yikes!  A join-binding with too few lambda
                   -- Lint will complain, but we don't want to crash
@@ -164,8 +166,10 @@ ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
         -- an atomic value (e.g. function args)
 
 ppr_expr add_par (Var name)
- | isJoinId name               = add_par ((text "jump") <+> ppr name)
- | otherwise                   = ppr name
+ | isJoinId name               = add_par ((text "jump") <+> pp_name)
+ | otherwise                   = pp_name
+ where
+   pp_name = pprPrefixOcc name
 ppr_expr add_par (Type ty)     = add_par (text "TYPE:" <+> ppr ty)       -- Weird
 ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co)
 ppr_expr add_par (Lit lit)     = pprLiteral add_par lit
@@ -429,7 +433,7 @@ pprKindedTyVarBndr tyvar
 -- pprIdBndr does *not* print the type
 -- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
 pprIdBndr :: Id -> SDoc
-pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
+pprIdBndr id = pprPrefixOcc id <+> pprIdBndrInfo (idInfo id)
 
 pprIdBndrInfo :: IdInfo -> SDoc
 pprIdBndrInfo info
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index a27aab1730..4e5f2be37d 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2122,7 +2122,7 @@ tcRnStmt hsc_env rdr_stmt
     }
   where
     bad_unboxed id = addErr (sep [text "GHCi can't bind a variable of unlifted type:",
-                                  nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
+                                  nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id))])
 
 {-
 --------------------------------------------------------------------------
@@ -2903,7 +2903,7 @@ ppr_types debug type_env
              -- etc are suppressed (unless -dppr-debug),
              -- because they appear elsewhere
 
-    ppr_sig id = hang (ppr id <+> dcolon) 2 (ppr (tidyTopType (idType id)))
+    ppr_sig id = hang (pprPrefixOcc id <+> dcolon) 2 (ppr (tidyTopType (idType id)))
 
 ppr_tycons :: Bool -> [FamInst] -> TypeEnv -> SDoc
 ppr_tycons debug fam_insts type_env
@@ -2921,7 +2921,7 @@ ppr_tycons debug fam_insts type_env
                      | otherwise  = isExternalName (tyConName tycon) &&
                                     not (tycon `elem` fi_tycons)
     ppr_tc tc
-       = vcat [ hang (ppr (tyConFlavour tc) <+> ppr tc
+       = vcat [ hang (ppr (tyConFlavour tc) <+> pprPrefixOcc (tyConName tc)
                       <> braces (ppr (tyConArity tc)) <+> dcolon)
                    2 (ppr (tidyTopType (tyConKind tc)))
               , nest 2 $
@@ -2955,7 +2955,7 @@ ppr_patsyns type_env
   = ppr_things "PATTERN SYNONYMS" ppr_ps
                (typeEnvPatSyns type_env)
   where
-    ppr_ps ps = ppr ps <+> dcolon <+> pprPatSynType ps
+    ppr_ps ps = pprPrefixOcc ps <+> dcolon <+> pprPatSynType ps
 
 ppr_insts :: [ClsInst] -> SDoc
 ppr_insts ispecs