[commit: ghc] master: Implement equalKeysUFM the right way (fbd9b88)

git at git.haskell.org git at git.haskell.org
Mon Mar 19 16:40:27 UTC 2018


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fbd9b886df92d1e0be0bdaacc7352273b504b78d/ghc

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

commit fbd9b886df92d1e0be0bdaacc7352273b504b78d
Author: David Feuer <david.feuer at gmail.com>
Date:   Mon Mar 19 12:03:36 2018 -0400

    Implement equalKeysUFM the right way
    
    Originally, we compared the key lists, which was kind of silly.
    Then I changed it to something fancier ... and also silly.
    This is much more reasonable, should be faster, and is nice and
    clear.
    
    Reviewers: bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D4500


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

fbd9b886df92d1e0be0bdaacc7352273b504b78d
 compiler/utils/UniqFM.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 2a9b806..a80880f 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -78,12 +78,10 @@ import Outputable
 import Data.List (foldl')
 
 import qualified Data.IntMap as M
-import qualified Data.IntMap.Merge.Lazy as M
-import Control.Applicative (Const (..))
-import qualified Data.Monoid as Mon
 import qualified Data.IntSet as S
 import Data.Data
 import qualified Data.Semigroup as Semi
+import Data.Functor.Classes (Eq1 (..))
 
 
 newtype UniqFM ele = UFM (M.IntMap ele)
@@ -342,10 +340,7 @@ ufmToIntMap (UFM m) = m
 
 -- Determines whether two 'UniqFm's contain the same keys.
 equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
-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
+equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
 
 -- Instances
 



More information about the ghc-commits mailing list