Commit 5416fadb authored by niteria's avatar niteria

Refactor some ppr functions to use pprUFM

Nondeterminism doesn't matter in these places and pprUFM makes
it obvious. I've flipped the order of arguments for convenience.

Test Plan: ./validate

Reviewers: simonmar, bgamari, austin, simonpj

Reviewed By: simonpj

Subscribers: thomie

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

GHC Trac Issues: #4012
parent 7c0b595e
......@@ -74,6 +74,7 @@ import FastString
import FieldLabel
import Outputable
import Unique
import UniqFM
import Util
import StaticFlags( opt_PprStyle_Debug )
......@@ -333,7 +334,7 @@ instance Outputable LocalRdrEnv where
= hang (text "LocalRdrEnv {")
2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env
, text "in_scope ="
<+> braces (pprWithCommas ppr (nameSetElems ns))
<+> pprUFM ns (braces . pprWithCommas ppr)
] <+> char '}')
where
ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
......
......@@ -196,9 +196,9 @@ pluralVarSet = pluralUFM
-- to use varSetElems at the call site. This prevents from let-binding
-- non-deterministically ordered lists and reusing them where determinism
-- matters.
pprVarSet :: ([Var] -> SDoc) -- ^ The pretty printing function to use on the
pprVarSet :: VarSet -- ^ The things to be pretty printed
-> ([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
......
......@@ -343,11 +343,13 @@ setInScope (Subst _ ids tvs cvs) in_scope = Subst in_scope ids tvs cvs
instance Outputable Subst where
ppr (Subst in_scope ids tvs cvs)
= text "<InScope =" <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
= text "<InScope =" <+> in_scope_doc
$$ text " IdSubst =" <+> ppr ids
$$ text " TvSubst =" <+> ppr tvs
$$ text " CvSubst =" <+> ppr cvs
<> char '>'
where
in_scope_doc = pprVarSet (getInScopeVars in_scope) (braces . fsep . map ppr)
{-
************************************************************************
......
......@@ -486,10 +486,10 @@ emptyPackageIfaceTable = emptyModuleEnv
pprHPT :: HomePackageTable -> SDoc
-- A bit aribitrary for now
pprHPT hpt
= vcat [ hang (ppr (mi_module (hm_iface hm)))
pprHPT hpt = pprUFM hpt $ \hms ->
vcat [ hang (ppr (mi_module (hm_iface hm)))
2 (ppr (md_types (hm_details hm)))
| hm <- eltsUFM hpt ]
| hm <- hms ]
lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
-- The HPT is indexed by ModuleName, not Module,
......
......@@ -132,10 +132,11 @@ pprSimplEnv env
= vcat [text "TvSubst:" <+> ppr (seTvSubst env),
text "CvSubst:" <+> ppr (seCvSubst env),
text "IdSubst:" <+> ppr (seIdSubst env),
text "InScope:" <+> vcat (map ppr_one in_scope_vars)
text "InScope:" <+> in_scope_vars_doc
]
where
in_scope_vars = varEnvElts (getInScopeVars (seInScope env))
in_scope_vars_doc = pprVarSet (getInScopeVars (seInScope env))
(vcat . map ppr_one)
ppr_one v | isId v = ppr v <+> ppr (idUnfolding v)
| otherwise = ppr v
......
......@@ -50,6 +50,7 @@ import VarSet
import Name ( Name, NamedThing(..), nameIsLocalOrFrom )
import NameSet
import NameEnv
import UniqFM
import Unify ( ruleMatchTyX )
import BasicTypes ( Activation, CompilerPhase, isActive, pprRuleName )
import StaticFlags ( opt_PprStyle_Debug )
......@@ -357,8 +358,9 @@ extendRuleBase rule_base rule
= extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule
pprRuleBase :: RuleBase -> SDoc
pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs)
| rs <- nameEnvElts rules ]
pprRuleBase rules = pprUFM rules $ \rss ->
vcat [ pprRules (tidyRules emptyTidyEnv rs)
| rs <- rss ]
{-
************************************************************************
......
......@@ -562,7 +562,7 @@ unusedInjectiveVarsErr (Pair invis_vars vis_vars) errorBuilder tyfamEqn
has_kinds = not $ isEmptyVarSet invis_vars
doc = sep [ what <+> text "variable" <>
pluralVarSet tvs <+> pprVarSet (pprQuotedList . toposortTyVars) tvs
pluralVarSet tvs <+> pprVarSet tvs (pprQuotedList . toposortTyVars)
, text "cannot be inferred from the right-hand side." ]
what = case (has_types, has_kinds) of
(True, True) -> text "Type and kind"
......
......@@ -402,7 +402,7 @@ checkInstCoverage be_liberal clas theta inst_taus
<+> text "determine rhs type"<>plural rs
<+> pprQuotedList rs ]
, text "Un-determined variable" <> pluralVarSet undet_set <> colon
<+> pprVarSet (pprWithCommas ppr) undet_set
<+> pprVarSet undet_set (pprWithCommas ppr)
, ppWhen (isEmptyVarSet $ pSnd undetermined_tvs) $
ppSuggestExplicitKinds
, ppWhen (not be_liberal &&
......
......@@ -178,7 +178,7 @@ report_unsolved mb_binds_var err_as_warn type_errors expr_holes type_holes wante
free_tvs = tyCoVarsOfWC wanted
; traceTc "reportUnsolved (after zonking and tidying):" $
vcat [ pprVarSet pprTvBndrs free_tvs
vcat [ pprVarSet free_tvs pprTvBndrs
, ppr wanted ]
; warn_redundant <- woptM Opt_WarnRedundantConstraints
......
......@@ -65,6 +65,7 @@ import SrcLoc
import Bag
import Outputable
import Util
import UniqFM
import Control.Monad
import Data.List ( partition )
......@@ -214,7 +215,7 @@ data ZonkEnv
-- Is only consulted lazily; hence knot-tying
instance Outputable ZonkEnv where
ppr (ZonkEnv _ _ty_env var_env) = vcat (map ppr (varEnvElts var_env))
ppr (ZonkEnv _ _ty_env var_env) = pprUFM var_env (vcat . map ppr)
-- The EvBinds have to already be zonked, but that's usually the case.
......
......@@ -2428,7 +2428,7 @@ pprTcGblEnv (TcGblEnv { tcg_type_env = type_env,
, vcat (map ppr rules)
, vcat (map ppr vects)
, text "Dependent modules:" <+>
ppr (sortBy cmp_mp $ eltsUFM (imp_dep_mods imports))
pprUFM (imp_dep_mods imports) (ppr . sortBy cmp_mp)
, text "Dependent packages:" <+>
ppr (sortBy stableUnitIdCmp $ imp_dep_pkgs imports)]
where -- The two uses of sortBy are just to reduce unnecessary
......
......@@ -349,12 +349,12 @@ pprUniqFM ppr_elt ufm
-- 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
-- nonDetEltsUFM.
pprUFM :: UniqFM a -- ^ The things to be pretty printed
-> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
-> SDoc -- ^ 'SDoc' where the things have been pretty
-- printed
pprUFM pp ufm = pp (nonDetEltsUFM ufm)
pprUFM ufm pp = pp (nonDetEltsUFM ufm)
-- | Determines the pluralisation suffix appropriate for the length of a set
-- in the same way that plural from Outputable does for lists.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment