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/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/PprC.hs

@@ -44,7 +44,6 @@ import ClosureInfo
 import DynFlags
 import Unique
 import UniqSet
-import FiniteMap
 import UniqFM
 import FastString
 import Outputable
@@ -57,6 +56,8 @@ import Data.List
 import Data.Bits
 import Data.Char
 import System.IO
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Word
 
 import Data.Array.ST
@@ -865,12 +866,12 @@ is_cish StdCallConv = True
 pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
 pprTempAndExternDecls stmts 
   = (vcat (map pprTempDecl (uniqSetToList temps)), 
-     vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls)))
+     vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
   where (temps, lbls) = runTE (mapM_ te_BB stmts)
 
 pprDataExterns :: [CmmStatic] -> SDoc
 pprDataExterns statics
-  = vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls))
+  = vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))
   where (_, lbls) = runTE (mapM_ te_Static statics)
 
 pprTempDecl :: LocalReg -> SDoc
@@ -901,7 +902,7 @@ pprExternDecl in_srt lbl
         <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
         <> semi
 
-type TEState = (UniqSet LocalReg, FiniteMap CLabel ())
+type TEState = (UniqSet LocalReg, Map CLabel ())
 newtype TE a = TE { unTE :: TEState -> (a, TEState) }
 
 instance Monad TE where
@@ -909,13 +910,13 @@ instance Monad TE where
    return a    = TE $ \s -> (a, s)
 
 te_lbl :: CLabel -> TE ()
-te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, addToFM lbls lbl ()))
+te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))
 
 te_temp :: LocalReg -> TE ()
 te_temp r = TE $ \(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))
 
 runTE :: TE () -> TEState
-runTE (TE m) = snd (m (emptyUniqSet, emptyFM))
+runTE (TE m) = snd (m (emptyUniqSet, Map.empty))
 
 te_Static :: CmmStatic -> TE ()
 te_Static (CmmStaticLit lit) = te_Lit lit

compiler/deSugar/Coverage.lhs

@@ -23,7 +23,6 @@ import FastString
 import HscTypes	
 import StaticFlags
 import TyCon
-import FiniteMap
 import MonadUtils
 import Maybes
 
@@ -35,6 +34,8 @@ import Trace.Hpc.Util
 
 import BreakArray 
 import Data.HashTable   ( hashString )
+import Data.Map (Map)
+import qualified Data.Map as Map
 \end{code}
 
 
@@ -76,8 +77,8 @@ addCoverageTicksToBinds dflags mod mod_loc tyCons binds =
 		       { fileName    = mkFastString orig_file2
 		      , declPath     = []
                       , inScope      = emptyVarSet
-		      , blackList    = listToFM [ (getSrcSpan (tyConName tyCon),()) 
-		      		       		| tyCon <- tyCons ]
+		      , blackList    = Map.fromList [ (getSrcSpan (tyConName tyCon),()) 
+		                                    | tyCon <- tyCons ]
 		       })
 		   (TT 
 		      { tickBoxCount = 0
@@ -574,7 +575,7 @@ data TickTransState = TT { tickBoxCount:: Int
 data TickTransEnv = TTE { fileName      :: FastString
 			, declPath     :: [String]
                         , inScope      :: VarSet
-			, blackList   :: FiniteMap SrcSpan ()
+			, blackList   :: Map SrcSpan ()
 			}
 
 --	deriving Show
@@ -658,7 +659,7 @@ bindLocals new_ids (TM m)
 
 isBlackListed :: SrcSpan -> TM Bool
 isBlackListed pos = TM $ \ env st -> 
-	      case lookupFM (blackList env) pos of
+	      case Map.lookup pos (blackList env) of
 	        Nothing -> (False,noFVs,st)
 		Just () -> (True,noFVs,st)
 

compiler/deSugar/Match.lhs

@@ -42,9 +42,10 @@ import SrcLoc
 import Maybes
 import Util
 import Name
-import FiniteMap
 import Outputable
 import FastString
+
+import qualified Data.Map as Map
 \end{code}
 
 This function is a wrapper of @match@, it must be called from all the parts where 
@@ -801,14 +802,14 @@ subGroup :: Ord a => [(a, EquationInfo)] -> [[EquationInfo]]
 -- Each sub-list in the result has the same PatGroup
 -- See Note [Take care with pattern order]
 subGroup group 
-    = map reverse $ eltsFM $ foldl accumulate emptyFM group
+    = map reverse $ Map.elems $ foldl accumulate Map.empty group
   where
     accumulate pg_map (pg, eqn)
-      = case lookupFM pg_map pg of
-          Just eqns -> addToFM pg_map pg (eqn:eqns)
-          Nothing   -> addToFM pg_map pg [eqn]
+      = case Map.lookup pg pg_map of
+          Just eqns -> Map.insert pg (eqn:eqns) pg_map
+          Nothing   -> Map.insert pg [eqn]      pg_map
 
-    -- pg_map :: FiniteMap a [EquationInfo]
+    -- pg_map :: Map a [EquationInfo]
     -- Equations seen so far in reverse order of appearance
 \end{code}
 

compiler/ghci/ByteCodeAsm.lhs

@@ -23,7 +23,6 @@ import ByteCodeItbls
 
 import Name
 import NameSet
-import FiniteMap
 import Literal
 import TyCon
 import PrimOp
@@ -42,6 +41,8 @@ import Data.Array.ST    ( castSTUArray )
 import Foreign
 import Data.Char        ( ord )
 import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
 
 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
 
@@ -128,19 +129,19 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced)
           | wORD_SIZE_IN_BITS == 64 = 4
           | wORD_SIZE_IN_BITS == 32 = 2
           | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
-         label_env = mkLabelEnv emptyFM lableInitialOffset instrs
+         label_env = mkLabelEnv Map.empty lableInitialOffset instrs
 
-         mkLabelEnv :: FiniteMap Word16 Word -> Word -> [BCInstr]
-                    -> FiniteMap Word16 Word
+         mkLabelEnv :: Map Word16 Word -> Word -> [BCInstr]
+                    -> Map Word16 Word
          mkLabelEnv env _ [] = env
          mkLabelEnv env i_offset (i:is)
             = let new_env
-                     = case i of LABEL n -> addToFM env n i_offset ; _ -> env
+                     = case i of LABEL n -> Map.insert n i_offset env ; _ -> env
               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 
          findLabel :: Word16 -> Word
          findLabel lab
-            = case lookupFM label_env lab of
+            = case Map.lookup lab label_env of
                  Just bco_offset -> bco_offset
                  Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
      in

compiler/ghci/ByteCodeGen.lhs

@@ -19,7 +19,6 @@ import Outputable
 import Name
 import MkId
 import Id
-import FiniteMap
 import ForeignCall
 import HscTypes
 import CoreUtils
@@ -62,6 +61,10 @@ import Data.Maybe
 import Module 
 import IdInfo 
 
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified FiniteMap as Map
+
 -- -----------------------------------------------------------------------------
 -- Generating byte code for a complete module 
 
@@ -127,13 +130,13 @@ type Sequel = Word16 -- back off to this depth before ENTER
 
 -- Maps Ids to the offset from the stack _base_ so we don't have
 -- to mess with it after each push/pop.
-type BCEnv = FiniteMap Id Word16 -- To find vars on the stack
+type BCEnv = Map Id Word16 -- To find vars on the stack
 
 {-
 ppBCEnv :: BCEnv -> SDoc
 ppBCEnv p
    = text "begin-env"
-     $$ nest 4 (vcat (map pp_one (sortBy cmp_snd (fmToList p))))
+     $$ nest 4 (vcat (map pp_one (sortBy cmp_snd (Map.toList p))))
      $$ text "end-env"
      where
         pp_one (var, offset) = int offset <> colon <+> ppr var <+> ppr (idCgRep var)
@@ -277,7 +280,7 @@ schemeR_wrk fvs nm original_body (args, body)
 
          szsw_args = map (fromIntegral . idSizeW) all_args
          szw_args  = sum szsw_args
-         p_init    = listToFM (zip all_args (mkStackOffsets 0 szsw_args))
+         p_init    = Map.fromList (zip all_args (mkStackOffsets 0 szsw_args))
 
 	 -- make the arg bitmap
 	 bits = argBits (reverse (map idCgRep all_args))
@@ -314,7 +317,7 @@ getVarOffSets d p = catMaybes . map (getOffSet d p) . tickInfo_locals
 
 getOffSet :: Word16 -> BCEnv -> Id -> Maybe (Id, Word16)
 getOffSet d env id 
-   = case lookupBCEnv_maybe env id of
+   = case lookupBCEnv_maybe id env of
         Nothing     -> Nothing 
         Just offset -> Just (id, d - offset)
 
@@ -329,7 +332,7 @@ fvsToEnv :: BCEnv -> VarSet -> [Id]
 -- it, have to agree about this layout
 fvsToEnv p fvs = [v | v <- varSetElems fvs, 
 		      isId v,		-- Could be a type variable
-		      v `elemFM` p]
+		      v `Map.member` p]
 
 -- -----------------------------------------------------------------------------
 -- schemeE
@@ -389,7 +392,7 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
 	-- saturatred constructor application.
 	-- Just allocate the constructor and carry on
         alloc_code <- mkConAppCode d s p data_con args_r_to_l
-        body_code <- schemeE (d+1) s (addToFM p x d) body
+        body_code <- schemeE (d+1) s (Map.insert x d p) body
         return (alloc_code `appOL` body_code)
 
 -- General case for let.  Generates correct, if inefficient, code in
@@ -411,7 +414,7 @@ schemeE d s p (AnnLet binds (_,body))
          -- are ptrs, so all have size 1.  d' and p' reflect the stack
          -- after the closures have been allocated in the heap (but not
          -- filled in), and pointers to them parked on the stack.
-         p'    = addListToFM p (zipE xs (mkStackOffsets d (genericReplicate n_binds 1)))
+         p'    = Map.insertList (zipE xs (mkStackOffsets d (genericReplicate n_binds 1))) p
          d'    = d + n_binds
          zipE  = zipEqual "schemeE"
 
@@ -802,7 +805,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 
         -- Env in which to compile the alts, not including
         -- any vars bound by the alts themselves
-        p_alts = addToFM p bndr (d_bndr - 1)
+        p_alts = Map.insert bndr (d_bndr - 1) p
 
 	bndr_ty = idType bndr
         isAlgCase = not (isUnLiftedType bndr_ty) && not is_unboxed_tuple
@@ -826,9 +829,10 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 		 bind_sizes   = ptr_sizes ++ nptrs_sizes
 		 size         = sum ptr_sizes + sum nptrs_sizes
 		 -- the UNPACK instruction unpacks in reverse order...
-		 p' = addListToFM p_alts 
+		 p' = Map.insertList
 			(zip (reverse (ptrs ++ nptrs))
 			  (mkStackOffsets d_alts (reverse bind_sizes)))
+                        p_alts 
 	     in do
              MASSERT(isAlgCase)
 	     rhs_code <- schemeE (d_alts+size) s p' rhs
@@ -877,7 +881,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 	bitmap = intsToReverseBitmap bitmap_size'{-size-}
                         (sortLe (<=) (filter (< bitmap_size') rel_slots))
 	  where
-	  binds = fmToList p
+	  binds = Map.toList p
 	  rel_slots = map fromIntegral $ concat (map spread binds)
 	  spread (id, offset)
 		| isFollowableArg (idCgRep id) = [ rel_offset ]
@@ -1206,7 +1210,7 @@ pushAtom d p (AnnVar v)
    | Just primop <- isPrimOpId_maybe v
    = return (unitOL (PUSH_PRIMOP primop), 1)
 
-   | Just d_v <- lookupBCEnv_maybe p v  -- v is a local variable
+   | Just d_v <- lookupBCEnv_maybe v p  -- v is a local variable
    = let l = d - d_v + sz - 2
      in return (toOL (genericReplicate sz (PUSH_L l)), sz)
 	 -- d - d_v 		    the number of words between the TOS 
@@ -1420,8 +1424,8 @@ instance Outputable Discr where
    ppr NoDiscr    = text "DEF"
 
 
-lookupBCEnv_maybe :: BCEnv -> Id -> Maybe Word16
-lookupBCEnv_maybe = lookupFM
+lookupBCEnv_maybe :: Id -> BCEnv -> Maybe Word16
+lookupBCEnv_maybe = Map.lookup
 
 idSizeW :: Id -> Int
 idSizeW id = cgRepSizeW (typeCgRep (idType id))

compiler/ghci/Linker.lhs

@@ -51,7 +51,6 @@ import ErrUtils
 import SrcLoc
 import qualified Maybes
 import UniqSet
-import FiniteMap
 import Constants
 import FastString
 import Config		( cProjectVersion )
@@ -62,6 +61,7 @@ import Control.Monad
 import Data.Char
 import Data.IORef
 import Data.List
+import qualified Data.Map as Map
 import Foreign
 import Control.Concurrent.MVar
 
@@ -1001,7 +1001,7 @@ linkPackages' dflags new_pks pls = do
 	| Just pkg_cfg <- lookupPackage pkg_map new_pkg
 	= do { 	-- Link dependents first
                pkgs' <- link pkgs [ Maybes.expectJust "link_one" $
-                                    lookupFM ipid_map ipid
+                                    Map.lookup ipid ipid_map
                                   | ipid <- depends pkg_cfg ]
 		-- Now link the package itself
 	     ; linkPackage dflags pkg_cfg

compiler/iface/IfaceEnv.lhs

@@ -31,7 +31,6 @@ import Module
 import UniqFM
 import FastString
 import UniqSupply
-import FiniteMap
 import BasicTypes
 import SrcLoc
 import MkId
@@ -40,6 +39,7 @@ import Outputable
 import Exception     ( evaluate )
 
 import Data.IORef    ( atomicModifyIORef, readIORef )
+import qualified Data.Map as Map
 \end{code}
 
 
@@ -176,14 +176,14 @@ newIPName occ_name_ip =
 	ipcache = nsIPs name_cache
         key = occ_name_ip  -- Ensures that ?x and %x get distinct Names
     in
-    case lookupFM ipcache key of
+    case Map.lookup key ipcache of
       Just name_ip -> (name_cache, name_ip)
       Nothing      -> (new_ns, name_ip)
 	  where
 	    (us', us1)  = splitUniqSupply (nsUniqs name_cache)
 	    uniq        = uniqFromSupply us1
 	    name_ip     = mapIPName (mkIPName uniq) occ_name_ip
-	    new_ipcache = addToFM ipcache key name_ip
+	    new_ipcache = Map.insert key name_ip ipcache
 	    new_ns      = name_cache {nsUniqs = us', nsIPs = new_ipcache}
 \end{code}
 
@@ -220,9 +220,9 @@ extendOrigNameCache nc name
 
 extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
 extendNameCache nc mod occ name
-  = extendModuleEnv_C combine nc mod (unitOccEnv occ name)
+  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
   where
-    combine occ_env _ = extendOccEnv occ_env occ name
+    combine _ occ_env = extendOccEnv occ_env occ name
 
 getNameCache :: TcRnIf a b NameCache
 getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv; 
@@ -254,7 +254,7 @@ initNameCache :: UniqSupply -> [Name] -> NameCache
 initNameCache us names
   = NameCache { nsUniqs = us,
 		nsNames = initOrigNames names,
-		nsIPs   = emptyFM }
+		nsIPs   = Map.empty }
 
 initOrigNames :: [Name] -> OrigNameCache
 initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names

compiler/iface/MkIface.lhs

@@ -87,7 +87,6 @@ import BasicTypes       hiding ( SuccessFlag(..) )
 import UniqFM
 import Unique
 import Util             hiding ( eqListBy )
-import FiniteMap
 import FastString
 import Maybes
 import ListSetOps
@@ -97,6 +96,8 @@ import Bag
 
 import Control.Monad
 import Data.List
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.IORef
 import System.FilePath
 \end{code}
@@ -523,7 +524,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                         -- wiki/Commentary/Compiler/RecompilationAvoidance
 
    -- put the declarations in a canonical order, sorted by OccName
-   let sorted_decls = eltsFM $ listToFM $
+   let sorted_decls = Map.elems $ Map.fromList $
                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
 
    -- the ABI hash depends on:
@@ -860,10 +861,10 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
         | otherwise
         = case nameModule_maybe name of
              Nothing  -> pprPanic "mkUsageInfo: internal name?" (ppr name)
-             Just mod -> -- We use this fiddly lambda function rather than
-                         -- (++) as the argument to extendModuleEnv_C to
+             Just mod -> -- This lambda function is really just a
+                         -- specialised (++); originally came about to
                          -- avoid quadratic behaviour (trac #2680)
-                         extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
+                         extendModuleEnvWith (\_ xs -> occ:xs) mv_map mod [occ]
     		   where occ = nameOccName name
     
     -- We want to create a Usage for a home module if 
@@ -897,7 +898,7 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
                       usg_mod_name = moduleName mod,
     	  	      usg_mod_hash = mod_hash,
     		      usg_exports  = export_hash,
-    		      usg_entities = fmToList ent_hashs }
+    		      usg_entities = Map.toList ent_hashs }
       where
 	maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 		-- In one-shot mode, the interfaces for home-package 
@@ -914,13 +915,13 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
     
         used_occs = lookupModuleEnv ent_map mod `orElse` []
 
-    	-- Making a FiniteMap here ensures that (a) we remove duplicates
+    	-- Making a Map here ensures that (a) we remove duplicates
         -- when we have usages on several subordinates of a single parent,
         -- and (b) that the usages emerge in a canonical order, which
-        -- is why we use FiniteMap rather than OccEnv: FiniteMap works
+        -- is why we use Map rather than OccEnv: Map works
         -- using Ord on the OccNames, which is a lexicographic ordering.
-	ent_hashs :: FiniteMap OccName Fingerprint
-        ent_hashs = listToFM (map lookup_occ used_occs)
+	ent_hashs :: Map OccName Fingerprint
+        ent_hashs = Map.fromList (map lookup_occ used_occs)
         
         lookup_occ occ = 
             case hash_env occ of
@@ -960,10 +961,10 @@ mkIfaceExports :: [AvailInfo]
                -> [(Module, [GenAvailInfo OccName])]
                   -- Group by module and sort by occurrence
 mkIfaceExports exports
-  = [ (mod, eltsFM avails)
+  = [ (mod, Map.elems avails)
     | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
                               (moduleEnvToList groupFM)
-                       -- NB. the fmToList is in a random order,
+                       -- NB. the Map.toList is in a random order,
                        -- because Ord Module is not a predictable
                        -- ordering.  Hence we perform a final sort
                        -- using the stable Module ordering.
@@ -971,20 +972,21 @@ mkIfaceExports exports
   where
 	-- Group by the module where the exported entities are defined
 	-- (which may not be the same for all Names in an Avail)
-	-- Deliberately use FiniteMap rather than UniqFM so we
+	-- Deliberately use Map rather than UniqFM so we
 	-- get a canonical ordering
-    groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
+    groupFM :: ModuleEnv (Map FastString (GenAvailInfo OccName))
     groupFM = foldl add emptyModuleEnv exports
 
-    add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
+    add_one :: ModuleEnv (Map FastString (GenAvailInfo OccName))
 	    -> Module -> GenAvailInfo OccName
-	    -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
+	    -> ModuleEnv (Map FastString (GenAvailInfo OccName))
     add_one env mod avail 
-      =  extendModuleEnv_C plusFM env mod 
-		(unitFM (occNameFS (availName avail)) avail)
+      -- XXX Is there a need to flip Map.union here?
+      =  extendModuleEnvWith (flip Map.union) env mod 
+		(Map.singleton (occNameFS (availName avail)) avail)
 
 	-- NB: we should not get T(X) and T(Y) in the export list
-	--     else the plusFM will simply discard one!  They
+	--     else the Map.union will simply discard one!  They