never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The AQUA Project, Glasgow University, 1994-1998
    4 
    5 
    6 UniqFM: Specialised finite maps, for things with @Uniques@.
    7 
    8 Basically, the things need to be in class @Uniquable@, and we use the
    9 @getUnique@ method to grab their @Uniques@.
   10 
   11 (A similar thing to @UniqSet@, as opposed to @Set@.)
   12 
   13 The interface is based on @FiniteMap@s, but the implementation uses
   14 @Data.IntMap@, which is both maintained and faster than the past
   15 implementation (see commit log).
   16 
   17 The @UniqFM@ interface maps directly to Data.IntMap, only
   18 ``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased
   19 and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
   20 of arguments of combining function.
   21 -}
   22 
   23 {-# LANGUAGE DeriveDataTypeable #-}
   24 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   25 {-# LANGUAGE ScopedTypeVariables #-}
   26 
   27 {-# OPTIONS_GHC -Wall #-}
   28 
   29 module GHC.Types.Unique.FM (
   30         -- * Unique-keyed mappings
   31         UniqFM,           -- abstract type
   32         NonDetUniqFM(..), -- wrapper for opting into nondeterminism
   33 
   34         -- ** Manipulating those mappings
   35         emptyUFM,
   36         unitUFM,
   37         unitDirectlyUFM,
   38         zipToUFM,
   39         listToUFM,
   40         listToUFM_Directly,
   41         listToUFM_C,
   42         listToIdentityUFM,
   43         addToUFM,addToUFM_C,addToUFM_Acc,
   44         addListToUFM,addListToUFM_C,
   45         addToUFM_Directly,
   46         addListToUFM_Directly,
   47         adjustUFM, alterUFM,
   48         adjustUFM_Directly,
   49         delFromUFM,
   50         delFromUFM_Directly,
   51         delListFromUFM,
   52         delListFromUFM_Directly,
   53         plusUFM,
   54         plusUFM_C,
   55         plusUFM_CD,
   56         plusUFM_CD2,
   57         mergeUFM,
   58         plusMaybeUFM_C,
   59         plusUFMList,
   60         sequenceUFMList,
   61         minusUFM,
   62         minusUFM_C,
   63         intersectUFM,
   64         intersectUFM_C,
   65         disjointUFM,
   66         equalKeysUFM,
   67         nonDetStrictFoldUFM, foldUFM, nonDetStrictFoldUFM_DirectlyM,
   68         anyUFM, allUFM, seqEltsUFM,
   69         mapUFM, mapUFM_Directly,
   70         mapMaybeUFM,
   71         elemUFM, elemUFM_Directly,
   72         filterUFM, filterUFM_Directly, partitionUFM,
   73         sizeUFM,
   74         isNullUFM,
   75         lookupUFM, lookupUFM_Directly,
   76         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
   77         nonDetEltsUFM, nonDetKeysUFM,
   78         ufmToSet_Directly,
   79         nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM,
   80         unsafeCastUFMKey,
   81         pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
   82     ) where
   83 
   84 import GHC.Prelude
   85 
   86 import GHC.Types.Unique ( Uniquable(..), Unique, getKey )
   87 import GHC.Utils.Outputable
   88 import GHC.Utils.Panic.Plain
   89 import qualified Data.IntMap as M
   90 import qualified Data.IntMap.Strict as MS
   91 import qualified Data.IntSet as S
   92 import Data.Data
   93 import qualified Data.Semigroup as Semi
   94 import Data.Functor.Classes (Eq1 (..))
   95 import Data.Coerce
   96 
   97 -- | A finite map from @uniques@ of one type to
   98 -- elements in another type.
   99 --
  100 -- The key is just here to keep us honest. It's always safe
  101 -- to use a single type as key.
  102 -- If two types don't overlap in their uniques it's also safe
  103 -- to index the same map at multiple key types. But this is
  104 -- very much discouraged.
  105 newtype UniqFM key ele = UFM (M.IntMap ele)
  106   deriving (Data, Eq, Functor)
  107   -- Nondeterministic Foldable and Traversable instances are accessible through
  108   -- use of the 'NonDetUniqFM' wrapper.
  109   -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
  110 
  111 emptyUFM :: UniqFM key elt
  112 emptyUFM = UFM M.empty
  113 
  114 isNullUFM :: UniqFM key elt -> Bool
  115 isNullUFM (UFM m) = M.null m
  116 
  117 unitUFM :: Uniquable key => key -> elt -> UniqFM key elt
  118 unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
  119 
  120 -- when you've got the Unique already
  121 unitDirectlyUFM :: Unique -> elt -> UniqFM key elt
  122 unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
  123 
  124 -- zipToUFM ks vs = listToUFM (zip ks vs)
  125 -- This function exists because it's a common case (#18535), and
  126 -- it's inefficient to first build a list of pairs, and then immediately
  127 -- take it apart. Astonishingly, fusing this one list away reduces total
  128 -- compiler allocation by more than 10% (in T12545, see !3935)
  129 -- Note that listToUFM (zip ks vs) performs similarly, but
  130 -- the explicit recursion avoids relying too much on fusion.
  131 zipToUFM :: Uniquable key => [key] -> [elt] -> UniqFM key elt
  132 zipToUFM ks vs = assert (length ks == length vs ) innerZip emptyUFM ks vs
  133   where
  134     innerZip ufm (k:kList) (v:vList) = innerZip (addToUFM ufm k v) kList vList
  135     innerZip ufm _ _ = ufm
  136 
  137 listToUFM :: Uniquable key => [(key,elt)] -> UniqFM key elt
  138 listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM
  139 
  140 listToUFM_Directly :: [(Unique, elt)] -> UniqFM key elt
  141 listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
  142 
  143 listToIdentityUFM :: Uniquable key => [key] -> UniqFM key key
  144 listToIdentityUFM = foldl' (\m x -> addToUFM m x x) emptyUFM
  145 
  146 listToUFM_C
  147   :: Uniquable key
  148   => (elt -> elt -> elt)
  149   -> [(key, elt)]
  150   -> UniqFM key elt
  151 listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM
  152 
  153 addToUFM :: Uniquable key => UniqFM key elt -> key -> elt  -> UniqFM key elt
  154 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
  155 
  156 addListToUFM :: Uniquable key => UniqFM key elt -> [(key,elt)] -> UniqFM key elt
  157 addListToUFM = foldl' (\m (k, v) -> addToUFM m k v)
  158 
  159 addListToUFM_Directly :: UniqFM key elt -> [(Unique,elt)] -> UniqFM key elt
  160 addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v)
  161 
  162 addToUFM_Directly :: UniqFM key elt -> Unique -> elt -> UniqFM key elt
  163 addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
  164 
  165 addToUFM_C
  166   :: Uniquable key
  167   => (elt -> elt -> elt)  -- old -> new -> result
  168   -> UniqFM key elt           -- old
  169   -> key -> elt           -- new
  170   -> UniqFM key elt           -- result
  171 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
  172 addToUFM_C f (UFM m) k v =
  173   UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
  174 
  175 addToUFM_Acc
  176   :: Uniquable key
  177   => (elt -> elts -> elts)  -- Add to existing
  178   -> (elt -> elts)          -- New element
  179   -> UniqFM key elts            -- old
  180   -> key -> elt             -- new
  181   -> UniqFM key elts            -- result
  182 addToUFM_Acc exi new (UFM m) k v =
  183   UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
  184 
  185 alterUFM
  186   :: Uniquable key
  187   => (Maybe elt -> Maybe elt)  -- How to adjust
  188   -> UniqFM key elt                -- old
  189   -> key                       -- new
  190   -> UniqFM key elt                -- result
  191 alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
  192 
  193 -- | Add elements to the map, combining existing values with inserted ones using
  194 -- the given function.
  195 addListToUFM_C
  196   :: Uniquable key
  197   => (elt -> elt -> elt)
  198   -> UniqFM key elt -> [(key,elt)]
  199   -> UniqFM key elt
  200 addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v)
  201 
  202 adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM key elt -> key -> UniqFM key elt
  203 adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
  204 
  205 adjustUFM_Directly :: (elt -> elt) -> UniqFM key elt -> Unique -> UniqFM key elt
  206 adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
  207 
  208 delFromUFM :: Uniquable key => UniqFM key elt -> key    -> UniqFM key elt
  209 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
  210 
  211 delListFromUFM :: Uniquable key => UniqFM key elt -> [key] -> UniqFM key elt
  212 delListFromUFM = foldl' delFromUFM
  213 
  214 delListFromUFM_Directly :: UniqFM key elt -> [Unique] -> UniqFM key elt
  215 delListFromUFM_Directly = foldl' delFromUFM_Directly
  216 
  217 delFromUFM_Directly :: UniqFM key elt -> Unique -> UniqFM key elt
  218 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
  219 
  220 -- Bindings in right argument shadow those in the left
  221 plusUFM :: UniqFM key elt -> UniqFM key elt -> UniqFM key elt
  222 -- M.union is left-biased, plusUFM should be right-biased.
  223 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
  224      -- Note (M.union y x), with arguments flipped
  225      -- M.union is left-biased, plusUFM should be right-biased.
  226 
  227 plusUFM_C :: (elt -> elt -> elt) -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
  228 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
  229 
  230 -- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
  231 -- combinding function and `d1` resp. `d2` as the default value if
  232 -- there is no entry in `m1` reps. `m2`. The domain is the union of
  233 -- the domains of `m1` and `m2`.
  234 --
  235 -- IMPORTANT NOTE: This function strictly applies the modification function
  236 -- and forces the result unlike most the other functions in this module.
  237 --
  238 -- Representative example:
  239 --
  240 -- @
  241 -- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
  242 --    == {A: f 1 42, B: f 2 3, C: f 23 4 }
  243 -- @
  244 {-# INLINE plusUFM_CD #-}
  245 plusUFM_CD
  246   :: (elta -> eltb -> eltc)
  247   -> UniqFM key elta  -- map X
  248   -> elta         -- default for X
  249   -> UniqFM key eltb  -- map Y
  250   -> eltb         -- default for Y
  251   -> UniqFM key eltc
  252 plusUFM_CD f (UFM xm) dx (UFM ym) dy
  253   = UFM $ MS.mergeWithKey
  254       (\_ x y -> Just (x `f` y))
  255       (MS.map (\x -> x `f` dy))
  256       (MS.map (\y -> dx `f` y))
  257       xm ym
  258 
  259 -- | `plusUFM_CD2 f m1 m2` merges the maps using `f` as the combining
  260 -- function. Unlike `plusUFM_CD`, a missing value is not defaulted: it is
  261 -- instead passed as `Nothing` to `f`. `f` can never have both its arguments
  262 -- be `Nothing`.
  263 --
  264 -- IMPORTANT NOTE: This function strictly applies the modification function
  265 -- and forces the result.
  266 --
  267 -- `plusUFM_CD2 f m1 m2` is the same as `plusUFM_CD f (mapUFM Just m1) Nothing
  268 -- (mapUFM Just m2) Nothing`.
  269 plusUFM_CD2
  270   :: (Maybe elta -> Maybe eltb -> eltc)
  271   -> UniqFM key elta  -- map X
  272   -> UniqFM key eltb  -- map Y
  273   -> UniqFM key eltc
  274 plusUFM_CD2 f (UFM xm) (UFM ym)
  275   = UFM $ MS.mergeWithKey
  276       (\_ x y -> Just (Just x `f` Just y))
  277       (MS.map (\x -> Just x `f` Nothing))
  278       (MS.map (\y -> Nothing `f` Just y))
  279       xm ym
  280 
  281 mergeUFM
  282   :: (elta -> eltb -> Maybe eltc)
  283   -> (UniqFM key elta -> UniqFM key eltc)  -- map X
  284   -> (UniqFM key eltb -> UniqFM key eltc) -- map Y
  285   -> UniqFM key elta
  286   -> UniqFM key eltb
  287   -> UniqFM key eltc
  288 mergeUFM f g h (UFM xm) (UFM ym)
  289   = UFM $ MS.mergeWithKey
  290       (\_ x y -> (x `f` y))
  291       (coerce g)
  292       (coerce h)
  293       xm ym
  294 
  295 plusMaybeUFM_C :: (elt -> elt -> Maybe elt)
  296                -> UniqFM key elt -> UniqFM key elt -> UniqFM key elt
  297 plusMaybeUFM_C f (UFM xm) (UFM ym)
  298     = UFM $ M.mergeWithKey
  299         (\_ x y -> x `f` y)
  300         id
  301         id
  302         xm ym
  303 
  304 plusUFMList :: [UniqFM key elt] -> UniqFM key elt
  305 plusUFMList = foldl' plusUFM emptyUFM
  306 
  307 sequenceUFMList :: forall key elt. [UniqFM key elt] -> UniqFM key [elt]
  308 sequenceUFMList = foldr (plusUFM_CD2 cons) emptyUFM
  309   where
  310     cons :: Maybe elt -> Maybe [elt] -> [elt]
  311     cons (Just x) (Just ys) = x : ys
  312     cons Nothing  (Just ys) = ys
  313     cons (Just x) Nothing   = [x]
  314     cons Nothing  Nothing   = []
  315 
  316 minusUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
  317 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
  318 
  319 -- | @minusUFC_C f map1 map2@ returns @map1@, except that every mapping @key
  320 -- |-> value1@ in @map1@ that shares a key with a mapping @key |-> value2@ in
  321 -- @map2@ is altered by @f@: @value1@ is replaced by @f value1 value2@, where
  322 -- 'Just' means that the new value is used and 'Nothing' means that the mapping
  323 -- is deleted.
  324 minusUFM_C :: (elt1 -> elt2 -> Maybe elt1) -> UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
  325 minusUFM_C f (UFM x) (UFM y) = UFM (M.differenceWith f x y)
  326 
  327 intersectUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1
  328 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
  329 
  330 intersectUFM_C
  331   :: (elt1 -> elt2 -> elt3)
  332   -> UniqFM key elt1
  333   -> UniqFM key elt2
  334   -> UniqFM key elt3
  335 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
  336 
  337 disjointUFM :: UniqFM key elt1 -> UniqFM key elt2 -> Bool
  338 disjointUFM (UFM x) (UFM y) = M.disjoint x y
  339 
  340 foldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a
  341 foldUFM k z (UFM m) = M.foldr k z m
  342 
  343 mapUFM :: (elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
  344 mapUFM f (UFM m) = UFM (M.map f m)
  345 
  346 mapMaybeUFM :: (elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2
  347 mapMaybeUFM f (UFM m) = UFM (M.mapMaybe f m)
  348 
  349 mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2
  350 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
  351 
  352 filterUFM :: (elt -> Bool) -> UniqFM key elt -> UniqFM key elt
  353 filterUFM p (UFM m) = UFM (M.filter p m)
  354 
  355 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM key elt -> UniqFM key elt
  356 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
  357 
  358 partitionUFM :: (elt -> Bool) -> UniqFM key elt -> (UniqFM key elt, UniqFM key elt)
  359 partitionUFM p (UFM m) =
  360   case M.partition p m of
  361     (left, right) -> (UFM left, UFM right)
  362 
  363 sizeUFM :: UniqFM key elt -> Int
  364 sizeUFM (UFM m) = M.size m
  365 
  366 elemUFM :: Uniquable key => key -> UniqFM key elt -> Bool
  367 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
  368 
  369 elemUFM_Directly :: Unique -> UniqFM key elt -> Bool
  370 elemUFM_Directly u (UFM m) = M.member (getKey u) m
  371 
  372 lookupUFM :: Uniquable key => UniqFM key elt -> key -> Maybe elt
  373 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
  374 
  375 -- when you've got the Unique already
  376 lookupUFM_Directly :: UniqFM key elt -> Unique -> Maybe elt
  377 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
  378 
  379 lookupWithDefaultUFM :: Uniquable key => UniqFM key elt -> elt -> key -> elt
  380 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
  381 
  382 lookupWithDefaultUFM_Directly :: UniqFM key elt -> elt -> Unique -> elt
  383 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
  384 
  385 ufmToSet_Directly :: UniqFM key elt -> S.IntSet
  386 ufmToSet_Directly (UFM m) = M.keysSet m
  387 
  388 anyUFM :: (elt -> Bool) -> UniqFM key elt -> Bool
  389 anyUFM p (UFM m) = M.foldr ((||) . p) False m
  390 
  391 allUFM :: (elt -> Bool) -> UniqFM key elt -> Bool
  392 allUFM p (UFM m) = M.foldr ((&&) . p) True m
  393 
  394 seqEltsUFM :: (elt -> ()) -> UniqFM key elt -> ()
  395 seqEltsUFM seqElt = foldUFM (\v rest -> seqElt v `seq` rest) ()
  396 
  397 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  398 -- If you use this please provide a justification why it doesn't introduce
  399 -- nondeterminism.
  400 nonDetEltsUFM :: UniqFM key elt -> [elt]
  401 nonDetEltsUFM (UFM m) = M.elems m
  402 
  403 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  404 -- If you use this please provide a justification why it doesn't introduce
  405 -- nondeterminism.
  406 nonDetKeysUFM :: UniqFM key elt -> [Unique]
  407 nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
  408 
  409 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  410 -- If you use this please provide a justification why it doesn't introduce
  411 -- nondeterminism.
  412 nonDetStrictFoldUFM :: (elt -> a -> a) -> a -> UniqFM key elt -> a
  413 nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m
  414 
  415 -- | In essence foldM
  416 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  417 -- If you use this please provide a justification why it doesn't introduce
  418 -- nondeterminism.
  419 {-# INLINE nonDetStrictFoldUFM_DirectlyM #-} -- Allow specialization
  420 nonDetStrictFoldUFM_DirectlyM :: (Monad m) => (Unique -> b -> elt -> m b) -> b -> UniqFM key elt -> m b
  421 nonDetStrictFoldUFM_DirectlyM f z0 (UFM xs) = M.foldrWithKey c return xs z0
  422   -- See Note [List fusion and continuations in 'c']
  423   where c u x k z = f (getUnique u) z x >>= k
  424         {-# INLINE c #-}
  425 
  426 -- See Note [Deterministic UniqFM] to learn about nondeterminism.
  427 -- If you use this please provide a justification why it doesn't introduce
  428 -- nondeterminism.
  429 nonDetUFMToList :: UniqFM key elt -> [(Unique, elt)]
  430 nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
  431 
  432 -- | A wrapper around 'UniqFM' with the sole purpose of informing call sites
  433 -- that the provided 'Foldable' and 'Traversable' instances are
  434 -- nondeterministic.
  435 -- If you use this please provide a justification why it doesn't introduce
  436 -- nondeterminism.
  437 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" to learn about determinism.
  438 newtype NonDetUniqFM key ele = NonDetUniqFM { getNonDet :: UniqFM key ele }
  439   deriving (Functor)
  440 
  441 -- | Inherently nondeterministic.
  442 -- If you use this please provide a justification why it doesn't introduce
  443 -- nondeterminism.
  444 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" to learn about determinism.
  445 instance forall key. Foldable (NonDetUniqFM key) where
  446   foldr f z (NonDetUniqFM (UFM m)) = foldr f z m
  447 
  448 -- | Inherently nondeterministic.
  449 -- If you use this please provide a justification why it doesn't introduce
  450 -- nondeterminism.
  451 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" to learn about determinism.
  452 instance forall key. Traversable (NonDetUniqFM key) where
  453   traverse f (NonDetUniqFM (UFM m)) = NonDetUniqFM . UFM <$> traverse f m
  454 
  455 ufmToIntMap :: UniqFM key elt -> M.IntMap elt
  456 ufmToIntMap (UFM m) = m
  457 
  458 unsafeIntMapToUFM :: M.IntMap elt -> UniqFM key elt
  459 unsafeIntMapToUFM = UFM
  460 
  461 -- | Cast the key domain of a UniqFM.
  462 --
  463 -- As long as the domains don't overlap in their uniques
  464 -- this is safe.
  465 unsafeCastUFMKey :: UniqFM key1 elt -> UniqFM key2 elt
  466 unsafeCastUFMKey (UFM m) = UFM m
  467 
  468 -- Determines whether two 'UniqFM's contain the same keys.
  469 equalKeysUFM :: UniqFM key a -> UniqFM key b -> Bool
  470 equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
  471 
  472 -- Instances
  473 
  474 instance Semi.Semigroup (UniqFM key a) where
  475   (<>) = plusUFM
  476 
  477 instance Monoid (UniqFM key a) where
  478     mempty = emptyUFM
  479     mappend = (Semi.<>)
  480 
  481 -- Output-ery
  482 
  483 instance Outputable a => Outputable (UniqFM key a) where
  484     ppr ufm = pprUniqFM ppr ufm
  485 
  486 pprUniqFM :: (a -> SDoc) -> UniqFM key a -> SDoc
  487 pprUniqFM ppr_elt ufm
  488   = brackets $ fsep $ punctuate comma $
  489     [ ppr uq <+> text ":->" <+> ppr_elt elt
  490     | (uq, elt) <- nonDetUFMToList ufm ]
  491   -- It's OK to use nonDetUFMToList here because we only use it for
  492   -- pretty-printing.
  493 
  494 -- | Pretty-print a non-deterministic set.
  495 -- The order of variables is non-deterministic and for pretty-printing that
  496 -- shouldn't be a problem.
  497 -- Having this function helps contain the non-determinism created with
  498 -- nonDetEltsUFM.
  499 pprUFM :: UniqFM key a      -- ^ The things to be pretty printed
  500        -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
  501        -> SDoc          -- ^ 'SDoc' where the things have been pretty
  502                         -- printed
  503 pprUFM ufm pp = pp (nonDetEltsUFM ufm)
  504 
  505 -- | Pretty-print a non-deterministic set.
  506 -- The order of variables is non-deterministic and for pretty-printing that
  507 -- shouldn't be a problem.
  508 -- Having this function helps contain the non-determinism created with
  509 -- nonDetUFMToList.
  510 pprUFMWithKeys
  511        :: UniqFM key a                -- ^ The things to be pretty printed
  512        -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
  513        -> SDoc                    -- ^ 'SDoc' where the things have been pretty
  514                                   -- printed
  515 pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
  516 
  517 -- | Determines the pluralisation suffix appropriate for the length of a set
  518 -- in the same way that plural from Outputable does for lists.
  519 pluralUFM :: UniqFM key a -> SDoc
  520 pluralUFM ufm
  521   | sizeUFM ufm == 1 = empty
  522   | otherwise = char 's'