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