Make benign non-determinism in pretty-printing more obvious

This change takes us one step closer to being able to remove
`varSetElemsWellScoped`. The end goal is to make every source
of non-determinism obvious at the source level, so that when
we achieve determinism it doesn't get broken accidentally.

Test Plan: compile GHC

Reviewers: simonmar, goldfire, simonpj, austin, bgamari

Reviewed By: simonpj

Subscribers: thomie

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

GHC Trac Issues: #4012

4 files changed, 44 insertions, 7 deletions

diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index 1cd9e21dab..8ece555e5d 100644
--- a/compiler/basicTypes/VarSet.hs
+++ b/compiler/basicTypes/VarSet.hs
@@ -21,6 +21,7 @@ module VarSet (
         lookupVarSet, lookupVarSetByName,
         mapVarSet, sizeVarSet, seqVarSet,
         elemVarSetByKey, partitionVarSet,
+        pluralVarSet, pprVarSet,
 
         -- * Deterministic Var set types
         DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
@@ -45,8 +46,9 @@ import Unique
 import Name     ( Name )
 import UniqSet
 import UniqDSet
-import UniqFM( disjointUFM )
+import UniqFM( disjointUFM, pluralUFM, pprUFM )
 import UniqDFM( disjointUDFM )
+import Outputable (SDoc)
 
 -- | A non-deterministic set of variables.
 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why it's not
@@ -169,6 +171,23 @@ transCloVarSet fn seeds
 seqVarSet :: VarSet -> ()
 seqVarSet s = sizeVarSet s `seq` ()
 
+-- | Determines the pluralisation suffix appropriate for the length of a set
+-- in the same way that plural from Outputable does for lists.
+pluralVarSet :: VarSet -> SDoc
+pluralVarSet = pluralUFM
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- varSetElems.
+pprVarSet :: ([Var] -> SDoc) -- ^ The pretty printing function to use on the
+                             -- elements
+          -> VarSet          -- ^ The things to be pretty printed
+          -> SDoc            -- ^ 'SDoc' where the things have been pretty
+                             -- printed
+pprVarSet = pprUFM
+
 -- Deterministic VarSet
 -- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
 -- DVarSet.
diff --git a/compiler/typecheck/FamInst.hs b/compiler/typecheck/FamInst.hs
index 5ac8b6840c..a7fad313a0 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -557,12 +557,12 @@ unusedInjectiveVarsErr (Pair invis_vars vis_vars) errorBuilder tyfamEqn
   = errorBuilder (injectivityErrorHerald True $$ msg)
                  [tyfamEqn]
     where
-      tvs = varSetElemsWellScoped (invis_vars `unionVarSet` vis_vars)
+      tvs = invis_vars `unionVarSet` vis_vars
       has_types = not $ isEmptyVarSet vis_vars
       has_kinds = not $ isEmptyVarSet invis_vars
 
       doc = sep [ what <+> text "variable" <>
-                  plural tvs <+> pprQuotedList tvs
+                  pluralVarSet tvs <+> pprVarSet (pprQuotedList . toposortTyVars) tvs
                 , text "cannot be inferred from the right-hand side." ]
       what = case (has_types, has_kinds) of
                (True, True)   -> text "Type and kind"
diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index 4aa7132ba3..4f213b2c6e 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -381,7 +381,7 @@ checkInstCoverage be_liberal clas theta inst_taus
          liberal_undet_tvs = (`minusVarSet` closed_ls_tvs) <$> rs_tvs
          conserv_undet_tvs = (`minusVarSet` ls_tvs)        <$> rs_tvs
 
-         undet_list = varSetElemsWellScoped (fold undetermined_tvs)
+         undet_set = fold undetermined_tvs
 
          msg = vcat [ -- text "ls_tvs" <+> ppr ls_tvs
                       -- , text "closed ls_tvs" <+> ppr (closeOverKinds ls_tvs)
@@ -401,8 +401,8 @@ checkInstCoverage be_liberal clas theta inst_taus
                              else text "do not jointly")
                             <+> text "determine rhs type"<>plural rs
                             <+> pprQuotedList rs ]
-                    , text "Un-determined variable" <> plural undet_list <> colon
-                            <+> pprWithCommas ppr undet_list
+                    , text "Un-determined variable" <> pluralVarSet undet_set <> colon
+                            <+> pprVarSet (pprWithCommas ppr) undet_set
                     , ppWhen (isEmptyVarSet $ pSnd undetermined_tvs) $
                       ppSuggestExplicitKinds
                     , ppWhen (not be_liberal &&
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 969e1dc10a..3632926d91 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -67,7 +67,7 @@ module UniqFM (
         eltsUFM, keysUFM, splitUFM,
         ufmToSet_Directly,
         ufmToList,
-        joinUFM, pprUniqFM
+        joinUFM, pprUniqFM, pprUFM, pluralUFM
     ) where
 
 import Unique           ( Uniquable(..), Unique, getKey )
@@ -324,3 +324,21 @@ pprUniqFM ppr_elt ufm
   = brackets $ fsep $ punctuate comma $
     [ ppr uq <+> text ":->" <+> ppr_elt elt
     | (uq, elt) <- ufmToList ufm ]
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- eltsUFM.
+pprUFM :: ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> UniqFM a      -- ^ The things to be pretty printed
+       -> SDoc          -- ^ 'SDoc' where the things have been pretty
+                        -- printed
+pprUFM pp ufm = pp (eltsUFM ufm)
+
+-- | Determines the pluralisation suffix appropriate for the length of a set
+-- in the same way that plural from Outputable does for lists.
+pluralUFM :: UniqFM a -> SDoc
+pluralUFM ufm
+  | sizeUFM ufm == 1 = empty
+  | otherwise = char 's'