[commit: ghc] ghc-8.2: Add an Eq instance for UniqSet (c52495c)

[git at git.haskell.org]

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

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/c52495c8dba2e2c8479caa405f2410ca6e54a9bc/ghc

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

commit c52495c8dba2e2c8479caa405f2410ca6e54a9bc
Author: David Feuer <david.feuer at gmail.com>
Date:   Thu May 4 14:16:02 2017 -0400

    Add an Eq instance for UniqSet
    
    I left that out by mistake, and it apparently breaks at least one
    existing plugin.
    
    Reviewers: christiaanb, austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3518
    
    (cherry picked from commit a660844c0859b7a2e76c15f2fb4abec209afea90)


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

c52495c8dba2e2c8479caa405f2410ca6e54a9bc
 compiler/utils/UniqFM.hs  | 17 +++++++++++++++++
 compiler/utils/UniqSet.hs |  6 ++++++
 2 files changed, 23 insertions(+)

diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 8214f17..71a092b 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -55,6 +55,7 @@ module UniqFM (
         intersectUFM,
         intersectUFM_C,
         disjointUFM,
+        equalKeysUFM,
         nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
         anyUFM, allUFM, seqEltsUFM,
         mapUFM, mapUFM_Directly,
@@ -76,6 +77,11 @@ import Outputable
 import Data.List (foldl')
 
 import qualified Data.IntMap as M
+#if MIN_VERSION_containers(0,5,9)
+import qualified Data.IntMap.Merge.Lazy as M
+import Control.Applicative (Const (..))
+import qualified Data.Monoid as Mon
+#endif
 import qualified Data.IntSet as S
 import Data.Typeable
 import Data.Data
@@ -339,6 +345,17 @@ nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 ufmToIntMap :: UniqFM elt -> M.IntMap elt
 ufmToIntMap (UFM m) = m
 
+-- Determines whether two 'UniqFm's contain the same keys.
+equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
+#if MIN_VERSION_containers(0,5,9)
+equalKeysUFM (UFM m1) (UFM m2) = Mon.getAll $ getConst $
+      M.mergeA (M.traverseMissing (\_ _ -> Const (Mon.All False)))
+               (M.traverseMissing (\_ _ -> Const (Mon.All False)))
+               (M.zipWithAMatched (\_ _ _ -> Const (Mon.All True))) m1 m2
+#else
+equalKeysUFM (UFM m1) (UFM m2) = M.keys m1 == M.keys m2
+#endif
+
 -- Instances
 
 #if __GLASGOW_HASKELL__ > 710
diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs
index ede900a..d9d51f4 100644
--- a/compiler/utils/UniqSet.hs
+++ b/compiler/utils/UniqSet.hs
@@ -128,6 +128,12 @@ mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
 -- the invariant.
 
 newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a} deriving Data
+
+-- Two 'UniqSet's are considered equal if they contain the same
+-- uniques.
+instance Eq (UniqSet a) where
+  UniqSet a == UniqSet b = equalKeysUFM a b
+
 getUniqSet :: UniqSet a -> UniqFM a
 getUniqSet = getUniqSet'