compiler/utils/UniqFM.lhs

   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 maitained 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 \begin{code}
  23 {-# OPTIONS -Wall #-}
  24 module UniqFM (
  25         -- * Unique-keyed mappings
  26         UniqFM,       -- abstract type
  27
  28         -- ** Manipulating those mappings
  29         emptyUFM,
  30         unitUFM,
  31         unitDirectlyUFM,
  32         listToUFM,
  33         listToUFM_Directly,
  34         listToUFM_C,
  35         addToUFM,addToUFM_C,addToUFM_Acc,
  36         addListToUFM,addListToUFM_C,
  37         addToUFM_Directly,
  38         addListToUFM_Directly,
  39         delFromUFM,
  40         delFromUFM_Directly,
  41         delListFromUFM,
  42         plusUFM,
  43         plusUFM_C,
  44         minusUFM,
  45         intersectUFM,
  46         intersectUFM_C,
  47         foldUFM, foldUFM_Directly,
  48         mapUFM,
  49         elemUFM, elemUFM_Directly,
  50         filterUFM, filterUFM_Directly,
  51         sizeUFM,
  52         isNullUFM,
  53         lookupUFM, lookupUFM_Directly,
  54         lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
  55         eltsUFM, keysUFM, splitUFM,
  56         ufmToList
  57     ) where
  58
  59 import Unique           ( Uniquable(..), Unique, getKey )
  60 import Outputable
  61
  62 import qualified Data.IntMap as M
  63 \end{code}
  64
  65 %************************************************************************
  66 %*                                                                      *
  67 \subsection{The signature of the module}
  68 %*                                                                      *
  69 %************************************************************************
  70
  71 \begin{code}
  72 emptyUFM        :: UniqFM elt
  73 isNullUFM       :: UniqFM elt -> Bool
  74 unitUFM         :: Uniquable key => key -> elt -> UniqFM elt
  75 unitDirectlyUFM -- got the Unique already
  76                 :: Unique -> elt -> UniqFM elt
  77 listToUFM       :: Uniquable key => [(key,elt)] -> UniqFM elt
  78 listToUFM_Directly
  79                 :: [(Unique, elt)] -> UniqFM elt
  80 listToUFM_C     :: Uniquable key => (elt -> elt -> elt)
  81                            -> [(key, elt)]
  82                            -> UniqFM elt
  83
  84 addToUFM        :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
  85 addListToUFM    :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
  86 addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
  87 addToUFM_Directly
  88                 :: UniqFM elt -> Unique -> elt -> UniqFM elt
  89
  90 addToUFM_C      :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
  91                            -> UniqFM elt                -- old
  92                            -> key -> elt                -- new
  93                            -> UniqFM elt                -- result
  94
  95 addToUFM_Acc    :: Uniquable key =>
  96                               (elt -> elts -> elts)     -- Add to existing
  97                            -> (elt -> elts)             -- New element
  98                            -> UniqFM elts               -- old
  99                            -> key -> elt                -- new
 100                            -> UniqFM elts               -- result
 101
 102 addListToUFM_C  :: Uniquable key => (elt -> elt -> elt)
 103                            -> UniqFM elt -> [(key,elt)]
 104                            -> UniqFM elt
 105
 106 delFromUFM      :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
 107 delListFromUFM  :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
 108 delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
 109
 110 -- Bindings in right argument shadow those in the left
 111 plusUFM         :: UniqFM elt -> UniqFM elt -> UniqFM elt
 112
 113 plusUFM_C       :: (elt -> elt -> elt)
 114                 -> UniqFM elt -> UniqFM elt -> UniqFM elt
 115
 116 minusUFM        :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
 117
 118 intersectUFM    :: UniqFM elt -> UniqFM elt -> UniqFM elt
 119 intersectUFM_C  :: (elt1 -> elt2 -> elt3)
 120                 -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
 121
 122 foldUFM         :: (elt -> a -> a) -> a -> UniqFM elt -> a
 123 foldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
 124 mapUFM          :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
 125 filterUFM       :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
 126 filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
 127
 128 sizeUFM         :: UniqFM elt -> Int
 129 --hashUFM               :: UniqFM elt -> Int
 130 elemUFM         :: Uniquable key => key -> UniqFM elt -> Bool
 131 elemUFM_Directly:: Unique -> UniqFM elt -> Bool
 132
 133 splitUFM        :: Uniquable key => UniqFM elt -> key -> (UniqFM elt, Maybe elt, UniqFM elt)
 134                    -- Splits a UFM into things less than, equal to, and greater than the key
 135 lookupUFM       :: Uniquable key => UniqFM elt -> key -> Maybe elt
 136 lookupUFM_Directly  -- when you've got the Unique already
 137                 :: UniqFM elt -> Unique -> Maybe elt
 138 lookupWithDefaultUFM
 139                 :: Uniquable key => UniqFM elt -> elt -> key -> elt
 140 lookupWithDefaultUFM_Directly
 141                 :: UniqFM elt -> elt -> Unique -> elt
 142 keysUFM         :: UniqFM elt -> [Unique]       -- Get the keys
 143 eltsUFM         :: UniqFM elt -> [elt]
 144 ufmToList       :: UniqFM elt -> [(Unique, elt)]
 145
 146 \end{code}
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsection{Implementation using ``Data.IntMap''}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 \begin{code}
 155 newtype UniqFM ele = UFM (M.IntMap ele)
 156
 157 emptyUFM = UFM M.empty
 158 isNullUFM (UFM m) = M.null m
 159 unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
 160 unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
 161 listToUFM = foldl (\m (k, v) -> addToUFM m k v) emptyUFM
 162 listToUFM_Directly = foldl (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
 163 listToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v) emptyUFM
 164
 165 addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
 166 addListToUFM = foldl (\m (k, v) -> addToUFM m k v)
 167 addListToUFM_Directly = foldl (\m (k, v) -> addToUFM_Directly m k v)
 168 addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
 169
 170 -- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
 171 addToUFM_C f (UFM m) k v =
 172   UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
 173 addToUFM_Acc exi new (UFM m) k v =
 174   UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
 175 addListToUFM_C f = foldl (\m (k, v) -> addToUFM_C f m k v)
 176
 177 delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
 178 delListFromUFM = foldl delFromUFM
 179 delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
 180
 181 -- M.union is left-biased, plusUFM should be right-biased.
 182 plusUFM (UFM x) (UFM y) = UFM (M.union y x)
 183 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
 184 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
 185 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
 186 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
 187
 188 foldUFM k z (UFM m) = M.fold k z m
 189 foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m
 190 mapUFM f (UFM m) = UFM (M.map f m)
 191 filterUFM p (UFM m) = UFM (M.filter p m)
 192 filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
 193
 194 sizeUFM (UFM m) = M.size m
 195 elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
 196 elemUFM_Directly u (UFM m) = M.member (getKey u) m
 197
 198 splitUFM (UFM m) k = case M.splitLookup (getKey $ getUnique k) m of
 199                        (less, equal, greater) -> (UFM less, equal, UFM greater)
 200 lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
 201 lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
 202 lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
 203 lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
 204 keysUFM (UFM m) = map getUnique $ M.keys m
 205 eltsUFM (UFM m) = M.elems m
 206 ufmToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
 207
 208 \end{code}
 209
 210 %************************************************************************
 211 %*                                                                      *
 212 \subsection{Output-ery}
 213 %*                                                                      *
 214 %************************************************************************
 215
 216 \begin{code}
 217 instance Outputable a => Outputable (UniqFM a) where
 218     ppr ufm = ppr (ufmToList ufm)
 219 \end{code}