[commit: ghc] wip/ghc-8.0-det: Make benign non-determinism in pretty-printing more obvious (cc02156)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/ghc-8.0-det
Link       : http://ghc.haskell.org/trac/ghc/changeset/cc02156b859159eff7d86043f67826c17f2bd170/ghc

>---------------------------------------------------------------

commit cc02156b859159eff7d86043f67826c17f2bd170
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Mon Apr 18 07:32:03 2016 -0700

    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
    
    (cherry picked from commit 0f96686b10fd36d479a54c71a6e1753193e85347)


>---------------------------------------------------------------

cc02156b859159eff7d86043f67826c17f2bd170
 compiler/basicTypes/VarSet.hs | 21 ++++++++++++++++++++-
 compiler/typecheck/FamInst.hs |  4 ++--
 compiler/typecheck/FunDeps.hs |  6 +++---
 compiler/utils/UniqFM.hs      | 20 +++++++++++++++++++-
 4 files changed, 44 insertions(+), 7 deletions(-)

diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs
index 1cd9e21..8ece555 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 2ff256d..1d9e1ce 100644
--- a/compiler/typecheck/FamInst.hs
+++ b/compiler/typecheck/FamInst.hs
@@ -562,12 +562,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 87fb4ff..776a9f1 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -387,7 +387,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)
@@ -407,8 +407,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) $
                       text "(Use -fprint-explicit-kinds to see the kind variables in the types)"
                     , ppWhen (not be_liberal &&
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index e261df7..4a5f14f 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 )
@@ -327,3 +327,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'