diff options
Diffstat (limited to 'compiler/utils/UniqFM.hs')
| -rw-r--r-- | compiler/utils/UniqFM.hs | 50 |
1 files changed, 16 insertions, 34 deletions
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs index 71a092b28e..d4a024d34c 100644 --- a/compiler/utils/UniqFM.hs +++ b/compiler/utils/UniqFM.hs @@ -20,7 +20,6 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order of arguments of combining function. -} -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -Wall #-} @@ -71,28 +70,20 @@ module UniqFM ( pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM ) where +import GhcPrelude + import Unique ( Uniquable(..), Unique, getKey ) 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 -#if __GLASGOW_HASKELL__ > 710 -import Data.Semigroup ( Semigroup ) -import qualified Data.Semigroup as Semigroup -#endif +import qualified Data.Semigroup as Semi +import Data.Functor.Classes (Eq1 (..)) newtype UniqFM ele = UFM (M.IntMap ele) - deriving (Data, Eq, Functor, Typeable) + deriving (Data, Eq, Functor) -- We used to derive Traversable and Foldable, but they were nondeterministic -- and not obvious at the call site. You can use explicit nonDetEltsUFM -- and fold a list if needed. @@ -112,26 +103,26 @@ unitDirectlyUFM :: Unique -> elt -> UniqFM elt unitDirectlyUFM u v = UFM (M.singleton (getKey u) v) listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt -listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM +listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt -listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM +listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM listToUFM_C :: Uniquable key => (elt -> elt -> elt) -> [(key, elt)] -> UniqFM elt -listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM +listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM addToUFM :: Uniquable key => UniqFM elt -> key -> elt -> UniqFM elt addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m) addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt -addListToUFM = foldl (\m (k, v) -> addToUFM m k v) +addListToUFM = foldl' (\m (k, v) -> addToUFM m k v) addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt -addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v) +addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v) addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m) @@ -169,7 +160,7 @@ addListToUFM_C => (elt -> elt -> elt) -> UniqFM elt -> [(key,elt)] -> UniqFM elt -addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) +addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m) @@ -181,10 +172,10 @@ delFromUFM :: Uniquable key => UniqFM elt -> key -> UniqFM elt delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m) delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt -delListFromUFM = foldl delFromUFM +delListFromUFM = foldl' delFromUFM delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt -delListFromUFM_Directly = foldl delFromUFM_Directly +delListFromUFM_Directly = foldl' delFromUFM_Directly delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m) @@ -347,25 +338,16 @@ 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 +equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2 -- Instances -#if __GLASGOW_HASKELL__ > 710 -instance Semigroup (UniqFM a) where +instance Semi.Semigroup (UniqFM a) where (<>) = plusUFM -#endif instance Monoid (UniqFM a) where mempty = emptyUFM - mappend = plusUFM + mappend = (Semi.<>) -- Output-ery |