diff --git a/compiler/basicTypes/VarEnv.hs b/compiler/basicTypes/VarEnv.hs index dd6125744aa92f3a3e5b53b559c15b4bb6ade369..5a852a3829e0bfeacdc19fd13f7d7f670747da92 100644 --- a/compiler/basicTypes/VarEnv.hs +++ b/compiler/basicTypes/VarEnv.hs @@ -109,8 +109,10 @@ data InScopeSet = InScope (VarEnv Var) {-# UNPACK #-} !Int -- INVARIANT: it's not zero; we use it as a multiplier in uniqAway instance Outputable InScopeSet where - ppr (InScope s _) = text "InScope" - <+> braces (fsep (map (ppr . Var.varName) (varSetElems s))) + ppr (InScope s _) = + text "InScope" <+> braces (fsep (map (ppr . Var.varName) (nonDetEltsUFM s))) + -- It's OK to use nonDetEltsUFM here because it's + -- only for pretty printing -- In-scope sets get big, and with -dppr-debug -- the output is overwhelming diff --git a/compiler/basicTypes/VarSet.hs b/compiler/basicTypes/VarSet.hs index 4663a41a5bd6eb4f461606bbcfb2ec39e72c2cad..b0151d8a22d05fe7cb136b49fc57bbf48a178673 100644 --- a/compiler/basicTypes/VarSet.hs +++ b/compiler/basicTypes/VarSet.hs @@ -12,7 +12,7 @@ module VarSet ( -- ** Manipulating these sets emptyVarSet, unitVarSet, mkVarSet, extendVarSet, extendVarSetList, extendVarSet_C, - elemVarSet, varSetElems, subVarSet, + elemVarSet, subVarSet, unionVarSet, unionVarSets, mapUnionVarSet, intersectVarSet, intersectsVarSet, disjointVarSet, isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey, @@ -72,7 +72,6 @@ unionVarSets :: [VarSet] -> VarSet mapUnionVarSet :: (a -> VarSet) -> [a] -> VarSet -- ^ map the function over the list, and union the results -varSetElems :: VarSet -> [Var] unitVarSet :: Var -> VarSet extendVarSet :: VarSet -> Var -> VarSet extendVarSetList:: VarSet -> [Var] -> VarSet @@ -108,7 +107,6 @@ subVarSet :: VarSet -> VarSet -> Bool -- True if first arg is subset o unionVarSet = unionUniqSets unionVarSets = unionManyUniqSets -varSetElems = uniqSetToList elemVarSet = elementOfUniqSet minusVarSet = minusUniqSet delVarSet = delOneFromUniqSet @@ -188,10 +186,10 @@ pluralVarSet = pluralUFM -- 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. +-- nonDetEltsUFM. -- Passing a list to the pretty-printing function allows the caller -- to decide on the order of Vars (eg. toposort them) without them having --- to use varSetElems at the call site. This prevents from let-binding +-- to use nonDetEltsUFM at the call site. This prevents from let-binding -- non-deterministically ordered lists and reusing them where determinism -- matters. pprVarSet :: VarSet -- ^ The things to be pretty printed diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index 4c621ddf2f639000c1ca39fb8ecc52e9de22944e..c889b4b840fdc190142d2d95a87d87a59bfc7a8e 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -648,7 +648,9 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds -- promoteTyVar ignores coercion variables ; outer_tclvl <- TcM.getTcLevel - ; mapM_ (promoteTyVar outer_tclvl) (varSetElems promote_tkvs) + ; mapM_ (promoteTyVar outer_tclvl) (nonDetEltsUFM promote_tkvs) + -- It's OK to use nonDetEltsUFM here because promoteTyVar is + -- commutative -- Emit an implication constraint for the -- remaining constraints from the RHS diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index b889a2f9815f0e6542560f2d8d8a00152acb3c6e..6873d32dd0a53f63451c817d3c4afd7613b08d50 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -19,6 +19,7 @@ import System.Environment( getArgs ) import VarSet import PprCore import Unique +import UniqFM import CoreLint import FastString @@ -173,7 +174,9 @@ main = do putMsg dflags (text n <> char ':') -- liftIO $ putMsg dflags (ppr e) let e' = callArityRHS e - let bndrs = varSetElems (allBoundIds e') + let bndrs = nonDetEltsUFM (allBoundIds e') + -- It should be OK to use nonDetEltsUFM here, if it becomes a + -- problem we should use DVarSet -- liftIO $ putMsg dflags (ppr e') forM_ bndrs $ \v -> putMsg dflags $ nest 4 $ ppr v <+> ppr (idCallArity v)