Reduce module qualifiers in pretty-printing

The change is in HscTypes.mkPrintUnqualified, and suppresses the
module qualifier on Names from ghc-prim, base, and template-haskell,
where no ambiguity can aries.  It's somewhat arbitrary, but helps
with things like 'Constraint' which are often not in scope, but
occasionally show up in error messages.

3 files changed, 31 insertions, 14 deletions

diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index ac2071f6b6..80b7cc84d9 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -534,8 +534,8 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
       NameQual modname -> ppr modname <> dot       -- Name is in scope
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
       NameNotInScope2  -> ppr (modulePackageKey mod) <> colon     -- Module not in
-                          <> ppr (moduleName mod) <> dot         -- scope either
-      _otherwise       -> empty
+                          <> ppr (moduleName mod) <> dot          -- scope either
+      NameUnqual       -> empty                   -- In scope unqualified
 
 ppr_underscore_unique :: Unique -> SDoc
 -- Print an underscore separating the name from its unique
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 90ed55978f..92c57ba0e5 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1524,11 +1524,26 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
                                              (mkQualPackage dflags)
   where
   qual_name mod occ
+        | [] <- unqual_gres
+        , modulePackageKey mod `elem` [primPackageKey, basePackageKey, thPackageKey]
+        , not (isDerivedOccName occ)
+        = NameUnqual   -- For names from ubiquitous packages that come with GHC, if
+                       -- there are no entities called unqualified 'occ', then
+                       -- print unqualified.  Doing so does not cause ambiguity,
+                       -- and it reduces the amount of qualification in error
+                       -- messages.  We can't do this for all packages, because we
+                       -- might get errors like "Can't unify T with T".  But the
+                       -- ubiquitous packages don't contain any such gratuitous
+                       -- name clashes.
+                       --
+                       -- A motivating example is 'Constraint'. It's often not in
+                       -- scope, but printing GHC.Prim.Constraint seems overkill.
+
         | [gre] <- unqual_gres
         , right_name gre
-        = NameUnqual
-                -- If there's a unique entity that's in scope unqualified with 'occ'
-                -- AND that entity is the right one, then we can use the unqualified name
+        = NameUnqual   -- If there's a unique entity that's in scope
+                       -- unqualified with 'occ' AND that entity is
+                       -- the right one, then we can use the unqualified name
 
         | [gre] <- qual_gres
         = NameQual (get_qual_mod (gre_prov gre))
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index e6e8e02dda..36ac6271be 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -173,15 +173,17 @@ type QueryQualifyModule = Module -> Bool
 type QueryQualifyPackage = PackageKey -> Bool
 
 -- See Note [Printing original names] in HscTypes
-data QualifyName                        -- given P:M.T
-        = NameUnqual                    -- refer to it as "T"
-        | NameQual ModuleName           -- refer to it as "X.T" for the supplied X
-        | NameNotInScope1
-                -- it is not in scope at all, but M.T is not bound in the current
-                -- scope, so we can refer to it as "M.T"
-        | NameNotInScope2
-                -- it is not in scope at all, and M.T is already bound in the
-                -- current scope, so we must refer to it as "P:M.T"
+data QualifyName   -- Given P:M.T
+  = NameUnqual           -- It's in scope unqualified as "T"
+                         -- OR nothing called "T" is in scope
+
+  | NameQual ModuleName  -- It's in scope qualified as "X.T"
+
+  | NameNotInScope1      -- It's not in scope at all, but M.T is not bound
+                         -- in the current scope, so we can refer to it as "M.T"
+
+  | NameNotInScope2      -- It's not in scope at all, and M.T is already bound in
+                         -- the current scope, so we must refer to it as "P:M.T"
 
 reallyAlwaysQualifyNames :: QueryQualifyName
 reallyAlwaysQualifyNames _ _ = NameNotInScope2