compiler/utils/FiniteMap.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1994-1998
   4 %
   5
   6 ``Finite maps'' are the heart of the compiler's lookup-tables/environments
   7 and its implementation of sets. Important stuff!
   8
   9 The implementation uses @Data.Map@ from the containers package, which
  10 is both maintained and faster than the past implementation (see commit log).
  11
  12 The orinigal interface is being kept around. It maps directly to Data.Map,
  13 only ``Data.Map.union'' is left-biased and ``plusFM'' right-biased and
  14 ``addToFM\_C'' and ``Data.Map.insertWith'' differ in the order of
  15 arguments of combining function.
  16
  17 \begin{code}
  18 module FiniteMap (
  19         -- * Mappings keyed from arbitrary types
  20         FiniteMap,   -- abstract data type
  21
  22         -- ** Manipulating those mappings
  23         emptyFM, unitFM, listToFM,
  24
  25         addToFM,
  26         addToFM_C,
  27         addListToFM,
  28         addListToFM_C,
  29         delFromFM,
  30         delListFromFM,
  31
  32         plusFM,
  33         plusFM_C,
  34         minusFM,
  35         foldFM,
  36
  37         intersectFM,
  38         intersectFM_C,
  39         mapFM, filterFM,
  40
  41         sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
  42
  43         fmToList, keysFM, eltsFM,
  44
  45         bagToFM
  46     ) where
  47
  48 import Bag ( Bag, foldrBag )
  49 import Outputable
  50
  51 import qualified Data.Map as M
  52
  53 \end{code}
  54
  55
  56 %************************************************************************
  57 %*                                                                      *
  58 \subsection{The signature of the module}
  59 %*                                                                      *
  60 %************************************************************************
  61
  62 \begin{code}
  63 -- BUILDING
  64 emptyFM     :: FiniteMap key elt
  65 unitFM      :: key -> elt -> FiniteMap key elt
  66 -- | In the case of duplicates keys, the last item is taken
  67 listToFM    :: (Ord key) => [(key,elt)] -> FiniteMap key elt
  68 -- | In the case of duplicate keys, who knows which item is taken
  69 bagToFM     :: (Ord key) => Bag (key,elt) -> FiniteMap key elt
  70
  71 -- ADDING AND DELETING
  72
  73 -- | Throws away any previous binding
  74 addToFM     :: (Ord key)
  75             => FiniteMap key elt -> key -> elt -> FiniteMap key elt
  76 -- | Throws away any previous binding, items are added left-to-right
  77 addListToFM :: (Ord key)
  78             => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
  79
  80 -- | Combines added item with previous item, if any --
  81 -- if the key is present, ``addToFM_C f`` inserts
  82 -- ``(key, f old_value new_value)''
  83 addToFM_C       :: (Ord key) => (elt -> elt -> elt)
  84                            -> FiniteMap key elt -> key -> elt
  85                            -> FiniteMap key elt
  86 -- | Combines added item with previous item, if any, items are added left-to-right
  87 addListToFM_C   :: (Ord key) => (elt -> elt -> elt)
  88                            -> FiniteMap key elt -> [(key,elt)]
  89                            -> FiniteMap key elt
  90
  91 -- | Deletion doesn't complain if you try to delete something which isn't there
  92 delFromFM       :: (Ord key)
  93                 => FiniteMap key elt -> key   -> FiniteMap key elt
  94 -- | Deletion doesn't complain if you try to delete something which isn't there
  95 delListFromFM   :: (Ord key)
  96                 => FiniteMap key elt -> [key] -> FiniteMap key elt
  97
  98 -- COMBINING
  99
 100 -- | Bindings in right argument shadow those in the left
 101 plusFM          :: (Ord key)
 102                 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
 103
 104 -- | Combines bindings for the same thing with the given function,
 105 -- bindings in right argument shadow those in the left
 106 plusFM_C        :: (Ord key)
 107                 => (elt -> elt -> elt)
 108                 -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
 109
 110 -- | Deletes from the left argument any bindings in the right argument
 111 minusFM         :: (Ord key)
 112                 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
 113
 114 intersectFM     :: (Ord key)
 115                 => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
 116 -- | Combines bindings for the same thing in the two maps with the given function
 117 intersectFM_C   :: (Ord key)
 118                 => (elt1 -> elt2 -> elt3)
 119                 -> FiniteMap key elt1 -> FiniteMap key elt2
 120                 -> FiniteMap key elt3
 121
 122 -- MAPPING, FOLDING, FILTERING
 123 foldFM          :: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
 124 mapFM           :: (key -> elt1 -> elt2)
 125                 -> FiniteMap key elt1 -> FiniteMap key elt2
 126 filterFM        :: (Ord key)
 127                 => (key -> elt -> Bool)
 128                 -> FiniteMap key elt -> FiniteMap key elt
 129
 130 -- INTERROGATING
 131 sizeFM                  :: FiniteMap key elt -> Int
 132 isEmptyFM               :: FiniteMap key elt -> Bool
 133
 134 elemFM                  :: (Ord key)
 135                         => key -> FiniteMap key elt -> Bool
 136 lookupFM                :: (Ord key)
 137                         => FiniteMap key elt -> key -> Maybe elt
 138 -- | Supplies a "default" element in return for an unmapped key
 139 lookupWithDefaultFM     :: (Ord key)
 140                         => FiniteMap key elt -> elt -> key -> elt
 141
 142 -- LISTIFYING
 143 fmToList        :: FiniteMap key elt -> [(key,elt)]
 144 keysFM          :: FiniteMap key elt -> [key]
 145 eltsFM          :: FiniteMap key elt -> [elt]
 146 \end{code}
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsection{Implementation using ``Data.Map''}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 \begin{code}
 155 newtype FiniteMap key elt = FM (M.Map key elt)
 156
 157 emptyFM = FM M.empty
 158 unitFM k v = FM (M.singleton k v)
 159 listToFM l = FM (M.fromList l)
 160
 161 addToFM (FM m) k v = FM (M.insert k v m)
 162 -- Arguments of combining function of M.insertWith and addToFM_C are flipped.
 163 addToFM_C f (FM m) k v = FM (M.insertWith (flip f) k v m)
 164 addListToFM = foldl (\m (k, v) -> addToFM m k v)
 165 addListToFM_C f = foldl (\m (k, v) -> addToFM_C f m k v)
 166 delFromFM (FM m) k = FM (M.delete k m)
 167 delListFromFM = foldl delFromFM
 168
 169 -- M.union is left-biased, plusFM should be right-biased.
 170 plusFM (FM x) (FM y) = FM (M.union y x)
 171 plusFM_C f (FM x) (FM y) = FM (M.unionWith f x y)
 172 minusFM (FM x) (FM y) = FM (M.difference x y)
 173 #if MIN_VERSION_containers(0,4,0)
 174 foldFM k z (FM m) = M.foldrWithKey k z m
 175 #else
 176 foldFM k z (FM m) = M.foldWithKey k z m
 177 #endif
 178
 179 intersectFM (FM x) (FM y) = FM (M.intersection x y)
 180 intersectFM_C f (FM x) (FM y) = FM (M.intersectionWith f x y)
 181 mapFM f (FM m) = FM (M.mapWithKey f m)
 182 filterFM p (FM m) = FM (M.filterWithKey p m)
 183
 184 sizeFM (FM m) = M.size m
 185 isEmptyFM (FM m) = M.null m
 186 elemFM k (FM m) = M.member k m
 187 lookupFM (FM m) k = M.lookup k m
 188 lookupWithDefaultFM (FM m) v k = M.findWithDefault v k m
 189
 190 fmToList (FM m) = M.toList m
 191 keysFM (FM m) = M.keys m
 192 eltsFM (FM m) = M.elems m
 193
 194 bagToFM = foldrBag (\(k,v) m -> addToFM m k v) emptyFM
 195
 196 \end{code}
 197
 198 %************************************************************************
 199 %*                                                                      *
 200 \subsection{Output-ery}
 201 %*                                                                      *
 202 %************************************************************************
 203
 204 \begin{code}
 205 instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
 206     ppr fm = ppr (fmToList fm)
 207 \end{code}