Remove (most of) the FiniteMap wrapper

We still have
    insertList, insertListWith, deleteList
which aren't in Data.Map, and
    foldRightWithKey
which works around the fold(r)WithKey addition and deprecation.

compiler/basicTypes/Module.lhs

@@ -5,7 +5,7 @@
 Module
 ~~~~~~~~~~
 Simply the name of a module, represented as a FastString.
-These are Uniquable, hence we can build FiniteMaps with Modules as
+These are Uniquable, hence we can build Maps with Modules as
 the keys.
 
 \begin{code}
@@ -60,7 +60,7 @@ module Module
 	lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
 	moduleEnvKeys, moduleEnvElts, moduleEnvToList,
         unitModuleEnv, isEmptyModuleEnv,
-        foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
+        foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
 
 	-- * ModuleName mappings
 	ModuleNameEnv,
@@ -76,13 +76,15 @@ import Config
 import Outputable
 import qualified Pretty
 import Unique
-import FiniteMap
 import UniqFM
 import FastString
 import Binary
 import Util
 
 import Data.Data
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
 import System.FilePath
 \end{code}
 
@@ -370,76 +372,76 @@ mainPackageId	   = fsToPackageId (fsLit "main")
 
 \begin{code}
 -- | A map keyed off of 'Module's
-newtype ModuleEnv elt = ModuleEnv (FiniteMap Module elt)
+newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 
 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
-filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)
+filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
 
 elemModuleEnv :: Module -> ModuleEnv a -> Bool
-elemModuleEnv m (ModuleEnv e) = elemFM m e
+elemModuleEnv m (ModuleEnv e) = Map.member m e
 
 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
 
-extendModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv_C f (ModuleEnv e) m x = ModuleEnv (addToFM_C f e m x)
+extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
 
 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)
+extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
 
 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
                       -> ModuleEnv a
-extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)
+extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
 
 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
 
 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
-delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)
+delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
 
 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
-delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)
+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
 
 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
 
 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
-lookupModuleEnv (ModuleEnv e) m = lookupFM e m
+lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
 
 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
-lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m
+lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
 
 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
-mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
 
 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
-mkModuleEnv xs = ModuleEnv (listToFM xs)
+mkModuleEnv xs = ModuleEnv (Map.fromList xs)
 
 emptyModuleEnv :: ModuleEnv a
-emptyModuleEnv = ModuleEnv emptyFM
+emptyModuleEnv = ModuleEnv Map.empty
 
 moduleEnvKeys :: ModuleEnv a -> [Module]
-moduleEnvKeys (ModuleEnv e) = keysFM e
+moduleEnvKeys (ModuleEnv e) = Map.keys e
 
 moduleEnvElts :: ModuleEnv a -> [a]
-moduleEnvElts (ModuleEnv e) = eltsFM e
+moduleEnvElts (ModuleEnv e) = Map.elems e
 
 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
-moduleEnvToList (ModuleEnv e) = fmToList e
+moduleEnvToList (ModuleEnv e) = Map.toList e
 
 unitModuleEnv :: Module -> a -> ModuleEnv a
-unitModuleEnv m x = ModuleEnv (unitFM m x)
+unitModuleEnv m x = ModuleEnv (Map.singleton m x)
 
 isEmptyModuleEnv :: ModuleEnv a -> Bool
-isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e
+isEmptyModuleEnv (ModuleEnv e) = Map.null e
 
 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
-foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
+foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
 \end{code}
 
 \begin{code}
 -- | A set of 'Module's
-type ModuleSet = FiniteMap Module ()
+type ModuleSet = Map Module ()
 
 mkModuleSet	:: [Module] -> ModuleSet
 extendModuleSet :: ModuleSet -> Module -> ModuleSet
@@ -447,11 +449,11 @@ emptyModuleSet  :: ModuleSet
 moduleSetElts   :: ModuleSet -> [Module]
 elemModuleSet   :: Module -> ModuleSet -> Bool
 
-emptyModuleSet    = emptyFM
-mkModuleSet ms    = listToFM [(m,()) | m <- ms ]
-extendModuleSet s m = addToFM s m ()
-moduleSetElts     = keysFM
-elemModuleSet     = elemFM
+emptyModuleSet    = Map.empty
+mkModuleSet ms    = Map.fromList [(m,()) | m <- ms ]
+extendModuleSet s m = Map.insert m () s
+moduleSetElts     = Map.keys
+elemModuleSet     = Map.member
 \end{code}
 
 A ModuleName has a Unique, so we can build mappings of these using

compiler/cmm/CmmBuildInfoTables.hs

@@ -33,7 +33,6 @@ import CmmTx
 import DFMonad
 import Module
 import FastString
-import FiniteMap
 import ForeignCall
 import IdInfo
 import Data.List
@@ -54,6 +53,10 @@ import qualified ZipCfg as G
 import ZipCfgCmmRep
 import ZipDataflow
 
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
+
 ----------------------------------------------------------------
 -- Building InfoTables
 
@@ -133,12 +136,12 @@ live_ptrs oldByte slotEnv areaMap bid =
 
         liveSlots :: [RegSlotInfo]
         liveSlots = sortBy (\ (off,_,_) (off',_,_) -> compare off' off)
-                           (foldFM (\_ -> flip $ foldl add_slot) [] slots)
+                           (Map.foldRightWithKey (\_ -> flip $ foldl add_slot) [] slots)
                     
         add_slot :: [RegSlotInfo] -> SubArea -> [RegSlotInfo]
         add_slot rst (a@(RegSlot r@(LocalReg _ ty)), off, w) = 
           if off == w && widthInBytes (typeWidth ty) == w then
-            (expectJust "add_slot" (lookupFM areaMap a), r, w) : rst
+            (expectJust "add_slot" (Map.lookup a areaMap), r, w) : rst
           else panic "live_ptrs: only part of a variable live at a proc point"
         add_slot rst (CallArea Old, _, _) =
           rst -- the update frame (or return infotable) should be live
@@ -155,7 +158,7 @@ live_ptrs oldByte slotEnv areaMap bid =
 
         slots :: SubAreaSet	 -- The SubAreaSet for 'bid'
         slots = expectJust "live_ptrs slots" $ lookupBlockEnv slotEnv bid
-        youngByte = expectJust "live_ptrs bid_pos" $ lookupFM areaMap (CallArea (Young bid))
+        youngByte = expectJust "live_ptrs bid_pos" $ Map.lookup (CallArea (Young bid)) areaMap
 
 -- Construct the stack maps for the given procedure.
 setInfoTableStackMap :: SlotEnv -> AreaMap -> CmmTopForInfoTables -> CmmTopForInfoTables 
@@ -187,14 +190,16 @@ setInfoTableStackMap _ _ t = pprPanic "unexpected case for setInfoTableStackMap"
 -----------------------------------------------------------------------
 -- Finding the CAFs used by a procedure
 
-type CAFSet = FiniteMap CLabel ()
+type CAFSet = Map CLabel ()
 type CAFEnv = BlockEnv CAFSet
 
 -- First, an analysis to find live CAFs.
 cafLattice :: DataflowLattice CAFSet
-cafLattice = DataflowLattice "live cafs" emptyFM add False
-  where add new old = if sizeFM new' > sizeFM old then aTx new' else noTx new'
-          where new' = new `plusFM` old
+cafLattice = DataflowLattice "live cafs" Map.empty add False
+  where add new old = if Map.size new' > Map.size old
+                      then aTx new'
+                      else noTx new'
+          where new' = new `Map.union` old
 
 cafTransfers :: BackwardTransfers Middle Last CAFSet
 cafTransfers = BackwardTransfers first middle last
@@ -206,7 +211,7 @@ cafTransfers = BackwardTransfers first middle last
                CmmLit (CmmLabelOff c _)         -> add c set
                CmmLit (CmmLabelDiffOff c1 c2 _) -> add c1 $ add c2 set
                _ -> set
-        add l s = if hasCAF l then addToFM s (cvtToClosureLbl l) () else s
+        add l s = if hasCAF l then Map.insert (cvtToClosureLbl l) () s else s
 
 type CafFix a = FuelMonad (BackwardFixedPoint Middle Last CAFSet a)
 cafAnal :: LGraph Middle Last -> FuelMonad CAFEnv
@@ -222,7 +227,7 @@ cafAnal g = liftM zdfFpFacts (res :: CafFix ())
 data TopSRT = TopSRT { lbl      :: CLabel
                      , next_elt :: Int -- the next entry in the table
                      , rev_elts :: [CLabel]
-                     , elt_map  :: FiniteMap CLabel Int }
+                     , elt_map  :: Map CLabel Int }
                         -- map: CLabel -> its last entry in the table
 instance Outputable TopSRT where
   ppr (TopSRT lbl next elts eltmap) =
@@ -231,19 +236,19 @@ instance Outputable TopSRT where
 emptySRT :: MonadUnique m => m TopSRT
 emptySRT =
   do top_lbl <- getUniqueM >>= \ u -> return $ mkSRTLabel (mkFCallName u "srt") NoCafRefs
-     return TopSRT { lbl = top_lbl, next_elt = 0, rev_elts = [], elt_map = emptyFM }
+     return TopSRT { lbl = top_lbl, next_elt = 0, rev_elts = [], elt_map = Map.empty }
 
 cafMember :: TopSRT -> CLabel -> Bool
-cafMember srt lbl = elemFM lbl (elt_map srt)
+cafMember srt lbl = Map.member lbl (elt_map srt)
 
 cafOffset :: TopSRT -> CLabel -> Maybe Int
-cafOffset srt lbl = lookupFM (elt_map srt) lbl
+cafOffset srt lbl = Map.lookup lbl (elt_map srt)
 
 addCAF :: CLabel -> TopSRT -> TopSRT
 addCAF caf srt =
   srt { next_elt = last + 1
       , rev_elts = caf : rev_elts srt
-      , elt_map  = addToFM (elt_map srt) caf last }
+      , elt_map  = Map.insert caf last (elt_map srt) }
     where last  = next_elt srt
 
 srtToData :: TopSRT -> CmmZ
@@ -258,16 +263,16 @@ srtToData srt = Cmm [CmmData RelocatableReadOnlyData (CmmDataLabel (lbl srt) : t
 -- in the SRT. Then, if the number of CAFs is small enough to fit in a bitmap,
 -- we make sure they're all close enough to the bottom of the table that the
 -- bitmap will be able to cover all of them.
-buildSRTs :: TopSRT -> FiniteMap CLabel CAFSet -> CAFSet ->
+buildSRTs :: TopSRT -> Map CLabel CAFSet -> CAFSet ->
              FuelMonad (TopSRT, Maybe CmmTopZ, C_SRT)
 buildSRTs topSRT topCAFMap cafs =
   do let liftCAF lbl () z = -- get CAFs for functions without static closures
-           case lookupFM topCAFMap lbl of Just cafs -> z `plusFM` cafs
-                                          Nothing   -> addToFM z lbl ()
+           case Map.lookup lbl topCAFMap of Just cafs -> z `Map.union` cafs
+                                            Nothing   -> Map.insert lbl () z
          -- For each label referring to a function f without a static closure,
          -- replace it with the CAFs that are reachable from f.
          sub_srt topSRT localCafs =
-           let cafs = keysFM (foldFM liftCAF emptyFM localCafs)
+           let cafs = Map.keys (Map.foldRightWithKey liftCAF Map.empty localCafs)
                mkSRT topSRT =
                  do localSRTs <- procpointSRT (lbl topSRT) (elt_map topSRT) cafs
                     return (topSRT, localSRTs)
@@ -283,7 +288,7 @@ buildSRTs topSRT topCAFMap cafs =
          add_if_too_far srt@(TopSRT {elt_map = m}) cafs =
            add srt (sortBy farthestFst cafs)
              where
-               farthestFst x y = case (lookupFM m x, lookupFM m y) of
+               farthestFst x y = case (Map.lookup x m, Map.lookup y m) of
                                    (Nothing, Nothing) -> EQ
                                    (Nothing, Just _)  -> LT
                                    (Just _,  Nothing) -> GT
@@ -301,7 +306,7 @@ buildSRTs topSRT topCAFMap cafs =
 
 -- Construct an SRT bitmap.
 -- Adapted from simpleStg/SRT.lhs, which expects Id's.
-procpointSRT :: CLabel -> FiniteMap CLabel Int -> [CLabel] ->
+procpointSRT :: CLabel -> Map CLabel Int -> [CLabel] ->
                 FuelMonad (Maybe CmmTopZ, C_SRT)
 procpointSRT _ _ [] =
  return (Nothing, NoC_SRT)
@@ -309,7 +314,7 @@ procpointSRT top_srt top_table entries =
  do (top, srt) <- bitmap `seq` to_SRT top_srt offset len bitmap
     return (top, srt)
   where
-    ints = map (expectJust "constructSRT" . lookupFM top_table) entries
+    ints = map (expectJust "constructSRT" . flip Map.lookup top_table) entries
     sorted_ints = sortLe (<=) ints
     offset = head sorted_ints
     bitmap_entries = map (subtract offset) sorted_ints
@@ -361,21 +366,21 @@ localCAFInfo cafEnv (CmmProc (CmmInfo _ _ infoTbl) top_l _ (_, LGraph entry _))
 -- the environment with every reference to f replaced by its set of CAFs.
 -- To do this replacement efficiently, we gather strongly connected
 -- components, then we sort the components in topological order.
-mkTopCAFInfo :: [(CLabel, CAFSet)] -> FiniteMap CLabel CAFSet
-mkTopCAFInfo localCAFs = foldl addToTop emptyFM g
+mkTopCAFInfo :: [(CLabel, CAFSet)] -> Map CLabel CAFSet
+mkTopCAFInfo localCAFs = foldl addToTop Map.empty g
   where addToTop env (AcyclicSCC (l, cafset)) =
-          addToFM env l (flatten env cafset)
+          Map.insert l (flatten env cafset) env
         addToTop env (CyclicSCC nodes) =
           let (lbls, cafsets) = unzip nodes
-              cafset  = foldl plusFM  emptyFM cafsets `delListFromFM` lbls
-          in foldl (\env l -> addToFM env l (flatten env cafset)) env lbls
-        flatten env cafset = foldFM (lookup env) emptyFM cafset
+              cafset  = lbls `Map.deleteList` foldl Map.union Map.empty cafsets
+          in foldl (\env l -> Map.insert l (flatten env cafset) env) env lbls
+        flatten env cafset = Map.foldRightWithKey (lookup env) Map.empty cafset
         lookup env caf () cafset' =
-          case lookupFM env caf of Just cafs -> foldFM add cafset' cafs
-                                   Nothing -> add caf () cafset'
-        add caf () cafset' = addToFM cafset' caf ()
+          case Map.lookup caf env of Just cafs -> Map.foldRightWithKey add cafset' cafs
+                                     Nothing -> add caf () cafset'
+        add caf () cafset' = Map.insert caf () cafset'
         g = stronglyConnCompFromEdgedVertices
-              (map (\n@(l, cafs) -> (n, l, keysFM cafs)) localCAFs)
+              (map (\n@(l, cafs) -> (n, l, Map.keys cafs)) localCAFs)
 
 type StackLayout = [Maybe LocalReg]
 
@@ -388,10 +393,10 @@ bundleCAFs cafEnv t@(ProcInfoTable _ procpoints) =
              -- until we stop splitting the graphs at procpoints in the native path
 bundleCAFs cafEnv t@(FloatingInfoTable _ bid _) =
   (expectJust "bundleCAFs " (lookupBlockEnv cafEnv bid), t)
-bundleCAFs _ t@(NoInfoTable _) = (emptyFM, t)
+bundleCAFs _ t@(NoInfoTable _) = (Map.empty, t)
 
 -- Construct the SRTs for the given procedure.
-setInfoTableSRT :: FiniteMap CLabel CAFSet -> TopSRT -> (CAFSet, CmmTopForInfoTables) ->
+setInfoTableSRT :: Map CLabel CAFSet -> TopSRT -> (CAFSet, CmmTopForInfoTables) ->
                    FuelMonad (TopSRT, [CmmTopForInfoTables])
 setInfoTableSRT topCAFMap topSRT (cafs, t@(ProcInfoTable _ procpoints)) =
   case blockSetToList procpoints of
@@ -402,7 +407,7 @@ setInfoTableSRT topCAFMap topSRT (cafs, t@(FloatingInfoTable _ _ _)) =
   setSRT cafs topCAFMap topSRT t
 setInfoTableSRT _ topSRT (_, t@(NoInfoTable _)) = return (topSRT, [t])
 
-setSRT :: CAFSet -> FiniteMap CLabel CAFSet -> TopSRT ->
+setSRT :: CAFSet -> Map CLabel CAFSet -> TopSRT ->
           CmmTopForInfoTables -> FuelMonad (TopSRT, [CmmTopForInfoTables])
 setSRT cafs topCAFMap topSRT t =
   do (topSRT, cafTable, srt) <- buildSRTs topSRT topCAFMap cafs

compiler/cmm/CmmCPSZ.hs

@@ -24,10 +24,11 @@ import ZipCfgCmmRep
 
 import DynFlags
 import ErrUtils
-import FiniteMap
 import HscTypes
 import Data.Maybe
 import Control.Monad
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Outputable
 import StaticFlags
 
@@ -73,7 +74,7 @@ global to one compiler session.
 cpsTop :: HscEnv -> CmmTopZ ->
           IO ([(CLabel, CAFSet)],
               [(CAFSet, CmmTopForInfoTables)])
-cpsTop _ p@(CmmData {}) = return ([], [(emptyFM, NoInfoTable p)])
+cpsTop _ p@(CmmData {}) = return ([], [(Map.empty, NoInfoTable p)])
 cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), g)) =
     do 
        dump Opt_D_dump_cmmz "Pre Proc Points Added"  g
@@ -172,7 +173,7 @@ cpsTop hsc_env (CmmProc h l args (stackInfo@(entry_off, _), g)) =
 -- This probably belongs in CmmBuildInfoTables?
 -- We're just finishing the job here: once we know what CAFs are defined
 -- in non-static closures, we can build the SRTs.
-toTops :: HscEnv -> FiniteMap CLabel CAFSet -> (TopSRT, [[CmmTopZ]])
+toTops :: HscEnv -> Map CLabel CAFSet -> (TopSRT, [[CmmTopZ]])
                  -> [(CAFSet, CmmTopForInfoTables)] -> IO (TopSRT, [[CmmTopZ]])
 
 toTops hsc_env topCAFEnv (topSRT, tops) gs =

compiler/cmm/CmmExpr.hs

@@ -49,13 +49,13 @@ import BlockId
 import CLabel
 import Constants
 import FastString
-import FiniteMap
 import Outputable
 import Unique
 import UniqSet
 
 import Data.Word
 import Data.Int
+import Data.Map (Map)
 
 -----------------------------------------------------------------------------
 --		CmmExpr
@@ -117,9 +117,9 @@ necessarily at the young end of the Old area.
 End of note -}
 
 type SubArea    = (Area, Int, Int) -- area, offset, width
-type SubAreaSet = FiniteMap Area [SubArea]
+type SubAreaSet = Map Area [SubArea]
 
-type AreaMap    = FiniteMap Area Int
+type AreaMap    = Map Area Int
      -- Byte offset of the oldest byte of the Area, 
      -- relative to the oldest byte of the Old Area
 

compiler/cmm/CmmProcPointZ.hs

@@ -15,7 +15,6 @@ import CmmInfo
 import CmmLiveZ
 import CmmTx
 import DFMonad
-import FiniteMap
 import Data.List (sortBy)
 import Maybes
 import MkZipCfg
@@ -28,6 +27,8 @@ import ZipCfg
 import ZipCfgCmmRep
 import ZipDataflow
 
+import qualified Data.Map as Map
+
 -- Compute a minimal set of proc points for a control-flow graph.
 
 -- Determine a protocol for each proc point (which live variables will
@@ -399,9 +400,9 @@ splitAtProcPoints entry_label callPPs procPoints procMap
      graphEnv <- return $ fold_blocks addBlock emptyBlockEnv g
      -- Build a map from proc point BlockId to labels for their new procedures
      -- Due to common blockification, we may overestimate the set of procpoints.
-     let add_label map pp = return $ addToFM map pp lbl
+     let add_label map pp = return $ Map.insert pp lbl map
            where lbl = if pp == entry then entry_label else blockLbl pp
-     procLabels <- foldM add_label emptyFM
+     procLabels <- foldM add_label Map.empty
                          (filter (elemBlockEnv blocks) (blockSetToList procPoints))
      -- For each procpoint, we need to know the SP offset on entry.
      -- If the procpoint is:
@@ -434,7 +435,7 @@ splitAtProcPoints entry_label callPPs procPoints procMap
                         add_if_pp ti (add_if_pp fi rst)
                       LastOther (LastSwitch _ tbl) -> foldr add_if_pp rst (catMaybes tbl)
                       _ -> rst
-                  add_if_pp id rst = case lookupFM procLabels id of
+                  add_if_pp id rst = case Map.lookup id procLabels of
                                        Just x -> (id, x) : rst
                                        Nothing -> rst
               (jumpEnv, jumpBlocks) <-
@@ -456,14 +457,14 @@ splitAtProcPoints entry_label callPPs procPoints procMap
              CmmProc (CmmInfo gc upd_fr info_tbl) top_l top_args (replacePPIds g)
            else
              CmmProc emptyContInfoTable lbl [] (replacePPIds g)
-           where lbl = expectJust "pp label" $ lookupFM procLabels bid
+           where lbl = expectJust "pp label" $ Map.lookup bid procLabels
          to_proc (bid, g) =
            CmmProc (CmmInfo Nothing Nothing CmmNonInfoTable) lbl [] (replacePPIds g)
-             where lbl = expectJust "pp label" $ lookupFM procLabels bid
+             where lbl = expectJust "pp label" $ Map.lookup bid procLabels
          -- References to procpoint IDs can now be replaced with the infotable's label
          replacePPIds (x, g) = (x, map_nodes id (mapExpMiddle repl) (mapExpLast repl) g)
            where repl e@(CmmLit (CmmBlock bid)) =
-                   case lookupFM procLabels bid of
+                   case Map.lookup bid procLabels of
                      Just l  -> CmmLit (CmmLabel (entryLblToInfoLbl l))
                      Nothing -> e
                  repl e = e

compiler/cmm/CmmStackLayout.hs

@@ -18,7 +18,6 @@ import CmmExpr
 import CmmProcPointZ
 import CmmTx
 import DFMonad
-import FiniteMap
 import Maybes
 import MkZipCfg
 import MkZipCfgCmm hiding (CmmBlock, CmmGraph)
@@ -30,6 +29,10 @@ import ZipCfg as Z
 import ZipCfgCmmRep
 import ZipDataflow
 
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
+
 ------------------------------------------------------------------------
 --                    Stack Layout                                    --
 ------------------------------------------------------------------------
@@ -63,14 +66,14 @@ import ZipDataflow
 -- a single slot, on insertion.
 
 slotLattice :: DataflowLattice SubAreaSet
-slotLattice = DataflowLattice "live slots" emptyFM add False
-  where add new old = case foldFM addArea (False, old) new of
+slotLattice = DataflowLattice "live slots" Map.empty add False
+  where add new old = case Map.foldRightWithKey addArea (False, old) new of
                         (True,  x) -> aTx  x
                         (False, x) -> noTx x
         addArea a newSlots z = foldr (addSlot a) z newSlots
         addSlot a slot (changed, map) =
-          let (c, live) = liveGen slot $ lookupWithDefaultFM map [] a
-          in (c || changed, addToFM map a live)
+          let (c, live) = liveGen slot $ Map.findWithDefault [] a map
+          in (c || changed, Map.insert a live map)
 
 type SlotEnv   = BlockEnv SubAreaSet
   -- The sub-areas live on entry to the block
@@ -122,17 +125,17 @@ liveKill (a, hi, w) set = -- pprTrace "killing slots in area" (ppr a) $
 liveSlotTransfers :: BackwardTransfers Middle Last SubAreaSet
 liveSlotTransfers =
   BackwardTransfers first liveInSlots liveLastIn
-    where first id live = delFromFM live (CallArea (Young id))
+    where first id live = Map.delete (CallArea (Young id)) live
 
 -- Slot sets: adding slots, removing slots, and checking for membership.
 liftToArea :: Area -> ([SubArea] -> [SubArea]) -> SubAreaSet -> SubAreaSet 
 addSlot, removeSlot :: SubAreaSet -> SubArea -> SubAreaSet
 elemSlot            :: SubAreaSet -> SubArea -> Bool
-liftToArea a f map = addToFM map a $ f (lookupWithDefaultFM map [] a)
+liftToArea a f map = Map.insert a (f (Map.findWithDefault [] a map)) map
 addSlot    live (a, i, w) = liftToArea a (snd . liveGen  (a, i, w)) live
 removeSlot live (a, i, w) = liftToArea a       (liveKill (a, i, w)) live
 elemSlot   live (a, i, w) =
-  not $ fst $ liveGen  (a, i, w) (lookupWithDefaultFM live [] a)
+  not $ fst $ liveGen  (a, i, w) (Map.findWithDefault [] a live)
 
 removeLiveSlotDefs :: (DefinerOfSlots s, UserOfSlots s) => SubAreaSet -> s -> SubAreaSet
 removeLiveSlotDefs = foldSlotsDefd removeSlot
@@ -163,7 +166,7 @@ liveLastOut env l =
   where out = joinOuts slotLattice env l
         add_area _ n live | n == 0 = live
         add_area a n live =
-          addToFM live a $ snd $ liveGen (a, n, n) $ lookupWithDefaultFM live [] a
+          Map.insert a (snd $ liveGen (a, n, n) $ Map.findWithDefault [] a live) live
 
 -- The liveness analysis must be precise: otherwise, we won't know if a definition
 -- should really kill a live-out stack slot.
@@ -174,7 +177,7 @@ liveLastOut env l =
 -- every time, I provide a function to fold over the nodes, which should be a
 -- reasonably efficient approach for the implementations we envision.
 -- Of course, it will probably be much easier to program if we just return a list...
-type Set x = FiniteMap x ()
+type Set x = Map x ()
 data IGraphBuilder n =
   Builder { foldNodes     :: forall z. SubArea -> (n -> z -> z) -> z -> z
           , _wordsOccupied :: AreaMap -> AreaMap -> n -> [Int]
@@ -184,8 +187,8 @@ areaBuilder :: IGraphBuilder Area
 areaBuilder = Builder fold words
   where fold (a, _, _) f z = f a z
         words areaSize areaMap a =
-          case lookupFM areaMap a of
-            Just addr -> [addr .. addr + (lookupFM areaSize a `orElse`
+          case Map.lookup a areaMap of
+            Just addr -> [addr .. addr + (Map.lookup a areaSize `orElse`
                                           pprPanic "wordsOccupied: unknown area" (ppr a))]
             Nothing   -> []
 
@@ -195,10 +198,10 @@ areaBuilder = Builder fold words
 -- Now, we can build the interference graph.
 -- The usual story: a definition interferes with all live outs and all other
 -- definitions.
-type IGraph x = FiniteMap x (Set x)
+type IGraph x = Map x (Set x)
 type IGPair x = (IGraph x, IGraphBuilder x)
 igraph :: (Ord x) => IGraphBuilder x -> SlotEnv -> LGraph Middle Last -> IGraph x
-igraph builder env g = foldr interfere emptyFM (postorder_dfs g)
+igraph builder env g = foldr interfere Map.empty (postorder_dfs g)
   where foldN = foldNodes builder
         interfere block igraph =
           let (h, l) = goto_end (unzip block)
@@ -210,15 +213,15 @@ igraph builder env g = foldr interfere emptyFM (postorder_dfs g)
               addEdges igraph i out = fst $ foldSlotsDefd addDef (igraph, out) i
               addDef (igraph, out) def@(a, _, _) =
                 (foldN def (addDefN out) igraph,
-                 addToFM out a (snd $ liveGen def (lookupWithDefaultFM out [] a)))
+                 Map.insert a (snd $ liveGen def (Map.findWithDefault [] a out)) out)
               addDefN out n igraph =
                 let addEdgeNO o igraph = foldN o addEdgeNN igraph
                     addEdgeNN n' igraph = addEdgeNN' n n' $ addEdgeNN' n' n igraph
-                    addEdgeNN' n n' igraph = addToFM igraph n (addToFM set n' ())
-                      where set = lookupWithDefaultFM igraph emptyFM n
-                in foldFM (\ _ os igraph -> foldr addEdgeNO igraph os) igraph out
+                    addEdgeNN' n n' igraph = Map.insert n (Map.insert n' () set) igraph
+                      where set = Map.findWithDefault Map.empty n igraph
+                in Map.foldRightWithKey (\ _ os igraph -> foldr addEdgeNO igraph os) igraph out
               env' bid = lookupBlockEnv env bid `orElse` panic "unknown blockId in igraph"
-          in heads h $ case l of LastExit    -> (igraph, emptyFM)
+          in heads h $ case l of LastExit    -> (igraph, Map.empty)
                                  LastOther l -> (addEdges igraph l $ liveLastOut env' l,
                                                  liveLastIn l env')
 
@@ -230,7 +233,7 @@ getAreaSize :: ByteOff -> LGraph Middle Last -> AreaMap
   -- used for (a) variable spill slots, and (b) parameter passing ares for calls
 getAreaSize entry_off g@(LGraph _ _) =
   fold_blocks (fold_fwd_block first add_regslots last)
-              (unitFM (CallArea Old) entry_off) g
+              (Map.singleton (CallArea Old) entry_off) g
   where first _  z = z
         last l@(LastOther (LastCall _ Nothing args res _)) z =
           add_regslots l (add (add z area args) area res)
@@ -243,7 +246,7 @@ getAreaSize entry_off g@(LGraph _ _) =