diff options
| -rw-r--r-- | compiler/basicTypes/VarSet.hs | 21 | ||||
| -rw-r--r-- | compiler/typecheck/FamInst.hs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/FunDeps.hs | 6 | ||||
| -rw-r--r-- | 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 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' |