Revert "Batch merge"
[ghc.git] / compiler / utils / UniqFM.hs
index 1dc6cf5..33d73cc 100644 (file)
@@ -20,12 +20,8 @@ and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
 of arguments of combining function.
 -}
 
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -Wall #-}
 
 module UniqFM (
@@ -48,14 +44,19 @@ module UniqFM (
         delFromUFM,
         delFromUFM_Directly,
         delListFromUFM,
+        delListFromUFM_Directly,
         plusUFM,
         plusUFM_C,
         plusUFM_CD,
+        plusMaybeUFM_C,
+        plusUFMList,
         minusUFM,
         intersectUFM,
         intersectUFM_C,
         disjointUFM,
-        foldUFM, foldUFM_Directly,
+        equalKeysUFM,
+        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
+        anyUFM, allUFM, seqEltsUFM,
         mapUFM, mapUFM_Directly,
         elemUFM, elemUFM_Directly,
         filterUFM, filterUFM_Directly, partitionUFM,
@@ -63,256 +64,292 @@ module UniqFM (
         isNullUFM,
         lookupUFM, lookupUFM_Directly,
         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-        eltsUFM, keysUFM, splitUFM,
+        nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
         ufmToSet_Directly,
-        ufmToList,
-        joinUFM, pprUniqFM
+        nonDetUFMToList, ufmToIntMap,
+        pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
     ) where
 
-import FastString
+import GhcPrelude
+
 import Unique           ( Uniquable(..), Unique, getKey )
 import Outputable
 
-import Compiler.Hoopl   hiding (Unique)
-
 import qualified Data.IntMap as M
 import qualified Data.IntSet as S
-import qualified Data.Foldable as Foldable
-import qualified Data.Traversable as Traversable
-import Data.Typeable
 import Data.Data
-#if __GLASGOW_HASKELL__ > 710
-import Data.Semigroup   ( Semigroup )
-import qualified Data.Semigroup as Semigroup
-#endif
-
-{-
-************************************************************************
-*                                                                      *
-\subsection{The signature of the module}
-*                                                                      *
-************************************************************************
--}
-
-emptyUFM        :: UniqFM elt
-isNullUFM       :: UniqFM elt -> Bool
-unitUFM         :: Uniquable key => key -> elt -> UniqFM elt
-unitDirectlyUFM -- got the Unique already
-                :: Unique -> elt -> UniqFM elt
-listToUFM       :: Uniquable key => [(key,elt)] -> UniqFM elt
-listToUFM_Directly
-                :: [(Unique, elt)] -> UniqFM elt
-listToUFM_C     :: Uniquable key => (elt -> elt -> elt)
-                           -> [(key, elt)]
-                           -> UniqFM elt
-
-addToUFM        :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
-addListToUFM    :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
-addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
-addToUFM_Directly
-                :: UniqFM elt -> Unique -> elt -> UniqFM elt
-
-addToUFM_C      :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
-                           -> UniqFM elt                -- old
-                           -> key -> elt                -- new
-                           -> UniqFM elt                -- result
-
-addToUFM_Acc    :: Uniquable key =>
-                              (elt -> elts -> elts)     -- Add to existing
-                           -> (elt -> elts)             -- New element
-                           -> UniqFM elts               -- old
-                           -> key -> elt                -- new
-                           -> UniqFM elts               -- result
-
-alterUFM        :: Uniquable key =>
-                              (Maybe elt -> Maybe elt)  -- How to adjust
-                           -> UniqFM elt                -- old
-                           -> key                       -- new
-                           -> UniqFM elt                -- result
-
-addListToUFM_C  :: Uniquable key => (elt -> elt -> elt)
-                           -> UniqFM elt -> [(key,elt)]
-                           -> UniqFM elt
-
-adjustUFM       :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
-adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
-
-delFromUFM      :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
-delListFromUFM  :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
-delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
-
--- Bindings in right argument shadow those in the left
-plusUFM         :: UniqFM elt -> UniqFM elt -> UniqFM elt
+import qualified Data.Semigroup as Semi
+import Data.Functor.Classes (Eq1 (..))
 
-plusUFM_C       :: (elt -> elt -> elt)
-                -> UniqFM elt -> UniqFM elt -> UniqFM elt
 
--- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
--- combinding function and `d1` resp. `d2` as the default value if
--- there is no entry in `m1` reps. `m2`. The domain is the union of
--- the domains of `m1` and `m2`.
---
--- Representative example:
---
--- @
--- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
---    == {A: f 1 42, B: f 2 3, C: f 23 4 }
--- @
-plusUFM_CD      :: (elt -> elt -> elt)
-                -> UniqFM elt -> elt -> UniqFM elt -> elt -> UniqFM elt
+newtype UniqFM ele = UFM (M.IntMap ele)
+  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.
+  -- See Note [Deterministic UniqFM] in UniqDFM to learn about determinism.
 
-minusUFM        :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
+emptyUFM :: UniqFM elt
+emptyUFM = UFM M.empty
 
-intersectUFM    :: UniqFM elt -> UniqFM elt -> UniqFM elt
-intersectUFM_C  :: (elt1 -> elt2 -> elt3)
-                -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
-disjointUFM     :: UniqFM elt1 -> UniqFM elt2 -> Bool
+isNullUFM :: UniqFM elt -> Bool
+isNullUFM (UFM m) = M.null m
 
-foldUFM         :: (elt -> a -> a) -> a -> UniqFM elt -> a
-foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
-mapUFM          :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
-mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
-filterUFM       :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
-filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
-partitionUFM    :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
-
-sizeUFM         :: UniqFM elt -> Int
---hashUFM               :: UniqFM elt -> Int
-elemUFM         :: Uniquable key => key -> UniqFM elt -> Bool
-elemUFM_Directly:: Unique -> UniqFM elt -> Bool
-
-splitUFM        :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
-                   -- Splits a UFM into things less than, equal to, and greater than the key
-lookupUFM       :: Uniquable key => UniqFM elt -> key -> Maybe elt
-lookupUFM_Directly  -- when you've got the Unique already
-                :: UniqFM elt -> Unique -> Maybe elt
-lookupWithDefaultUFM
-                :: Uniquable key => UniqFM elt -> elt -> key -> elt
-lookupWithDefaultUFM_Directly
-                :: UniqFM elt -> elt -> Unique -> elt
-keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
-eltsUFM         :: UniqFM elt -> [elt]
-ufmToSet_Directly :: UniqFM elt -> S.IntSet
-ufmToList       :: UniqFM elt -> [(Unique, elt)]
+unitUFM :: Uniquable key => key -> elt -> UniqFM elt
+unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
 
-{-
-************************************************************************
-*                                                                      *
-\subsection{Monoid interface}
-*                                                                      *
-************************************************************************
--}
+-- when you've got the Unique already
+unitDirectlyUFM :: Unique -> elt -> UniqFM elt
+unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
 
-#if __GLASGOW_HASKELL__ > 710
-instance Semigroup (UniqFM a) where
-  (<>) = plusUFM
-#endif
+listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
+listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM
 
-instance Monoid (UniqFM a) where
-    mempty = emptyUFM
-    mappend = plusUFM
+listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt
+listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
 
-{-
-************************************************************************
-*                                                                      *
-\subsection{Implementation using ``Data.IntMap''}
-*                                                                      *
-************************************************************************
--}
+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
 
-newtype UniqFM ele = UFM (M.IntMap ele)
-  deriving (Data, Eq, Functor, Traversable.Traversable,
-            Typeable)
+addToUFM :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
+addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
 
-deriving instance Foldable.Foldable UniqFM
+addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addListToUFM = foldl' (\m (k, v) -> addToUFM m k v)
 
-emptyUFM = UFM M.empty
-isNullUFM (UFM m) = M.null m
-unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
-unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
-listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
-listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
-listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
+addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
+addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v)
 
-alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
-addToUFM (UFM m) k v   = UFM (M.insert (getKey $ getUnique k) v m)
-addListToUFM = foldl (\m (k, v) -> addToUFM 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)
 
+addToUFM_C
+  :: Uniquable key
+  => (elt -> elt -> elt)  -- old -> new -> result
+  -> UniqFM elt           -- old
+  -> key -> elt           -- new
+  -> UniqFM elt           -- result
 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
 addToUFM_C f (UFM m) k v =
   UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
+
+addToUFM_Acc
+  :: Uniquable key
+  => (elt -> elts -> elts)  -- Add to existing
+  -> (elt -> elts)          -- New element
+  -> UniqFM elts            -- old
+  -> key -> elt             -- new
+  -> UniqFM elts            -- result
 addToUFM_Acc exi new (UFM m) k v =
   UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
-addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
 
+alterUFM
+  :: Uniquable key
+  => (Maybe elt -> Maybe elt)  -- How to adjust
+  -> UniqFM elt                -- old
+  -> key                       -- new
+  -> UniqFM elt                -- result
+alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
+
+addListToUFM_C
+  :: Uniquable key
+  => (elt -> elt -> elt)
+  -> UniqFM elt -> [(key,elt)]
+  -> UniqFM elt
+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)
+
+adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
 adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
 
+delFromUFM :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
-delListFromUFM = foldl delFromUFM
+
+delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
+delListFromUFM = foldl' delFromUFM
+
+delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt
+delListFromUFM_Directly = foldl' delFromUFM_Directly
+
+delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
 
+-- Bindings in right argument shadow those in the left
+plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
 -- M.union is left-biased, plusUFM should be right-biased.
 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
      -- Note (M.union y x), with arguments flipped
      -- M.union is left-biased, plusUFM should be right-biased.
 
+plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
 
+-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
+-- combinding function and `d1` resp. `d2` as the default value if
+-- there is no entry in `m1` reps. `m2`. The domain is the union of
+-- the domains of `m1` and `m2`.
+--
+-- Representative example:
+--
+-- @
+-- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
+--    == {A: f 1 42, B: f 2 3, C: f 23 4 }
+-- @
+plusUFM_CD
+  :: (elt -> elt -> elt)
+  -> UniqFM elt  -- map X
+  -> elt         -- default for X
+  -> UniqFM elt  -- map Y
+  -> elt         -- default for Y
+  -> UniqFM elt
 plusUFM_CD f (UFM xm) dx (UFM ym) dy
+  = UFM $ M.mergeWithKey
+      (\_ x y -> Just (x `f` y))
+      (M.map (\x -> x `f` dy))
+      (M.map (\y -> dx `f` y))
+      xm ym
+
+plusMaybeUFM_C :: (elt -> elt -> Maybe elt)
+               -> UniqFM elt -> UniqFM elt -> UniqFM elt
+plusMaybeUFM_C f (UFM xm) (UFM ym)
     = UFM $ M.mergeWithKey
-        (\_ x y -> Just (x `f` y))
-        (M.map (\x -> x `f` dy))
-        (M.map (\y -> dx `f` y))
+        (\_ x y -> x `f` y)
+        id
+        id
         xm ym
+
+plusUFMList :: [UniqFM elt] -> UniqFM elt
+plusUFMList = foldl' plusUFM emptyUFM
+
+minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
+
+intersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
+
+intersectUFM_C
+  :: (elt1 -> elt2 -> elt3)
+  -> UniqFM elt1
+  -> UniqFM elt2
+  -> UniqFM elt3
 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
+
+disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
 disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
 
-foldUFM k z (UFM m) = M.fold k z m
-foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
+foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+foldUFM k z (UFM m) = M.foldr k z m
+
+mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 mapUFM f (UFM m) = UFM (M.map f m)
+
+mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
+
+filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 filterUFM p (UFM m) = UFM (M.filter p m)
+
+filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
-partitionUFM p (UFM m) = case M.partition p m of
-                           (left, right) -> (UFM left, UFM right)
 
+partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
+partitionUFM p (UFM m) =
+  case M.partition p m of
+    (left, right) -> (UFM left, UFM right)
+
+sizeUFM :: UniqFM elt -> Int
 sizeUFM (UFM m) = M.size m
+
+elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
+
+elemUFM_Directly :: Unique -> UniqFM elt -> Bool
 elemUFM_Directly u (UFM m) = M.member (getKey u) m
 
-splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
-                       (less, equal, greater) -> (UFM less, equal, UFM greater)
+lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
+
+-- when you've got the Unique already
+lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt
 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
+
+lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt
 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
+
+lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt
 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
-keysUFM (UFM m) = map getUnique $ M.keys m
+
+eltsUFM :: UniqFM elt -> [elt]
 eltsUFM (UFM m) = M.elems m
+
+ufmToSet_Directly :: UniqFM elt -> S.IntSet
 ufmToSet_Directly (UFM m) = M.keysSet m
-ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
-
--- Hoopl
-joinUFM :: JoinFun v -> JoinFun (UniqFM v)
-joinUFM eltJoin l (OldFact old) (NewFact new) = foldUFM_Directly add (NoChange, old) new
-    where add k new_v (ch, joinmap) =
-            case lookupUFM_Directly joinmap k of
-                Nothing -> (SomeChange, addToUFM_Directly joinmap k new_v)
-                Just old_v -> case eltJoin l (OldFact old_v) (NewFact new_v) of
-                                (SomeChange, v') -> (SomeChange, addToUFM_Directly joinmap k v')
-                                (NoChange, _) -> (ch, joinmap)
 
-{-
-************************************************************************
-*                                                                      *
-\subsection{Output-ery}
-*                                                                      *
-************************************************************************
--}
+anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+anyUFM p (UFM m) = M.foldr ((||) . p) False m
+
+allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+allUFM p (UFM m) = M.foldr ((&&) . p) True m
+
+seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()
+seqEltsUFM seqList = seqList . nonDetEltsUFM
+  -- It's OK to use nonDetEltsUFM here because the type guarantees that
+  -- the only interesting thing this function can do is to force the
+  -- elements.
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetEltsUFM :: UniqFM elt -> [elt]
+nonDetEltsUFM (UFM m) = M.elems m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetKeysUFM :: UniqFM elt -> [Unique]
+nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetFoldUFM k z (UFM m) = M.foldr k z m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
+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
+equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
+
+-- Instances
+
+instance Semi.Semigroup (UniqFM a) where
+  (<>) = plusUFM
+
+instance Monoid (UniqFM a) where
+    mempty = emptyUFM
+    mappend = (Semi.<>)
+
+-- Output-ery
 
 instance Outputable a => Outputable (UniqFM a) where
     ppr ufm = pprUniqFM ppr ufm
@@ -320,5 +357,37 @@ instance Outputable a => Outputable (UniqFM a) where
 pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
 pprUniqFM ppr_elt ufm
   = brackets $ fsep $ punctuate comma $
-    [ ppr uq <+> ptext (sLit ":->") <+> ppr_elt elt
-    | (uq, elt) <- ufmToList ufm ]
+    [ ppr uq <+> text ":->" <+> ppr_elt elt
+    | (uq, elt) <- nonDetUFMToList ufm ]
+  -- It's OK to use nonDetUFMToList here because we only use it for
+  -- pretty-printing.
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetEltsUFM.
+pprUFM :: UniqFM a      -- ^ The things to be pretty printed
+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc          -- ^ 'SDoc' where the things have been pretty
+                        -- printed
+pprUFM ufm pp = pp (nonDetEltsUFM ufm)
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetUFMToList.
+pprUFMWithKeys
+       :: UniqFM a                -- ^ The things to be pretty printed
+       -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc                    -- ^ 'SDoc' where the things have been pretty
+                                  -- printed
+pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
+
+-- | Determines the pluralisation suffix appropriate for the length of a set
+-- in the same way that plural from Outputable does for lists.
+pluralUFM :: UniqFM a -> SDoc
+pluralUFM ufm
+  | sizeUFM ufm == 1 = empty
+  | otherwise = char 's'