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.

3 files changed, 27 insertions, 22 deletions

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index d5ffae1d38..0fa7c62ff3 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/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
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 90931cc973..9330c7125b 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/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))
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index d53d2477e6..66a4576171 100644
--- a/compiler/ghci/Linker.lhs
+++ b/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