Refactor some ppr functions to use pprUFM
authorBartosz Nitka <niteria@gmail.com>
Thu, 12 May 2016 15:01:34 +0000 (08:01 -0700)
committerBartosz Nitka <niteria@gmail.com>
Thu, 12 May 2016 16:34:08 +0000 (09:34 -0700)
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

12 files changed:
compiler/basicTypes/RdrName.hs
compiler/basicTypes/VarSet.hs
compiler/coreSyn/CoreSubst.hs
compiler/main/HscTypes.hs
compiler/simplCore/SimplEnv.hs
compiler/specialise/Rules.hs
compiler/typecheck/FamInst.hs
compiler/typecheck/FunDeps.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/utils/UniqFM.hs

index ee63882..ec51ea5 100644 (file)
@@ -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
index 31718f6..2c2066a 100644 (file)
@@ -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
index 1f60e7c..7723b71 100644 (file)
@@ -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)
 
 {-
 ************************************************************************
index 800958b..e7673d6 100644 (file)
@@ -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,
index da82943..7061540 100644 (file)
@@ -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
 
index f9f195f..aebfbc7 100644 (file)
@@ -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 ]
 
 {-
 ************************************************************************
index a7fad31..6c357ce 100644 (file)
@@ -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"
index 4f213b2..bf42558 100644 (file)
@@ -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 &&
index d9ba069..878a3ea 100644 (file)
@@ -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
index 36aeb50..db7a5f9 100644 (file)
@@ -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.
index bb3056b..fa9216d 100644 (file)
@@ -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
index 2ff6352..f49dabc 100644 (file)
@@ -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.