Commit e95ee1f7 authored by Ian Lynagh's avatar Ian Lynagh

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.
parent 83a8fc9f
......@@ -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
......
This diff is collapsed.
......@@ -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 =
......
......@@ -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
......
......@@ -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
......
This diff is collapsed.
......@@ -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
......
......@@ -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)
......
......@@ -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}
......
......@@ -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
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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