[commit: ghc] wip/ghc-8.0-det: Add nameSetElemsStable and fix the build (c07b619)

git at git.haskell.org git at git.haskell.org
Thu Jul 14 13:54:04 UTC 2016


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

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

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

commit c07b61978fed55faec7b910155964a785e8b52a1
Author: Bartosz Nitka <niteria at gmail.com>
Date:   Thu Jun 2 10:34:57 2016 -0700

    Add nameSetElemsStable and fix the build


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

c07b61978fed55faec7b910155964a785e8b52a1
 compiler/basicTypes/NameSet.hs | 11 +++++++++++
 compiler/utils/UniqFM.hs       |  6 +++++-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/compiler/basicTypes/NameSet.hs b/compiler/basicTypes/NameSet.hs
index 7bca479..b764bd9 100644
--- a/compiler/basicTypes/NameSet.hs
+++ b/compiler/basicTypes/NameSet.hs
@@ -13,6 +13,7 @@ module NameSet (
         minusNameSet, elemNameSet, nameSetElems, extendNameSet, extendNameSetList,
         delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
         intersectsNameSet, intersectNameSet,
+        nameSetElemsStable,
 
         -- * Free variables
         FreeVars,
@@ -33,6 +34,8 @@ module NameSet (
 
 import Name
 import UniqSet
+import UniqFM
+import Data.List (sortBy)
 
 {-
 ************************************************************************
@@ -84,6 +87,14 @@ delListFromNameSet set ns = foldl delFromNameSet set ns
 
 intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
 
+-- | Get the elements of a NameSet with some stable ordering.
+-- See Note [Deterministic UniqFM] to learn about nondeterminism
+nameSetElemsStable :: NameSet -> [Name]
+nameSetElemsStable ns =
+  sortBy stableNameCmp $ nonDetEltsUFM ns
+  -- It's OK to use nonDetEltsUFM here because we immediately sort
+  -- with stableNameCmp
+
 {-
 ************************************************************************
 *                                                                      *
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 0df5a2d..0056287 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -64,7 +64,7 @@ module UniqFM (
         isNullUFM,
         lookupUFM, lookupUFM_Directly,
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-        eltsUFM, keysUFM, splitUFM,
+        eltsUFM, keysUFM, splitUFM, nonDetEltsUFM,
         ufmToSet_Directly,
         ufmToList, ufmToIntMap,
         joinUFM, pprUniqFM, pprUFM, pluralUFM
@@ -304,6 +304,10 @@ ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
+-- See Note [Deterministic UniqFM] to learn about nondeterminism
+nonDetEltsUFM :: UniqFM elt -> [elt]
+nonDetEltsUFM (UFM m) = M.elems m
+
 -- Hoopl
 joinUFM :: JoinFun v -> JoinFun (UniqFM v)
 joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new



More information about the ghc-commits mailing list