diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DynFlags.hs | 7 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 28 | ||||
| -rw-r--r-- | compiler/main/HscTypes.lhs | 4 | ||||
| -rw-r--r-- | compiler/main/Packages.lhs | 63 | ||||
| -rw-r--r-- | compiler/main/SysTools.lhs | 10 |
5 files changed, 60 insertions, 52 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index c9ac5f9185..47d9f6da1b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -88,7 +88,6 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString -import FiniteMap import Outputable import Foreign.C ( CInt ) import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -99,6 +98,8 @@ import Control.Monad ( when ) import Data.Char import Data.List +import Data.Map (Map) +import qualified Data.Map as Map import System.FilePath import System.IO ( stderr, hPutChar ) @@ -488,7 +489,7 @@ data DynFlags = DynFlags { -- These have to be IORefs, because the defaultCleanupHandler needs to -- know what to clean when an exception happens filesToClean :: IORef [FilePath], - dirsToClean :: IORef (FiniteMap FilePath FilePath), + dirsToClean :: IORef (Map FilePath FilePath), -- hsc dynamic flags flags :: [DynFlag], @@ -612,7 +613,7 @@ initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways refFilesToClean <- newIORef [] - refDirsToClean <- newIORef emptyFM + refDirsToClean <- newIORef Map.empty return dflags{ ways = ways, buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 92345c7314..c3aa8323de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -286,7 +286,6 @@ import SysTools ( initSysTools, cleanTempFiles, cleanTempFilesExcept, import Annotations import Module import UniqFM -import FiniteMap import Panic import Digraph import Bag ( unitBag, listToBag, emptyBag, isEmptyBag ) @@ -303,6 +302,9 @@ import Lexer import System.Directory ( getModificationTime, doesFileExist, getCurrentDirectory ) import Data.Maybe +import Data.Map (Map) +import qualified Data.Map as Map +import qualified FiniteMap as Map import Data.List import qualified Data.List as List import Data.Typeable ( Typeable ) @@ -1827,14 +1829,14 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l numbered_summaries = zip summaries [1..] lookup_node :: HscSource -> ModuleName -> Maybe SummaryNode - lookup_node hs_src mod = lookupFM node_map (mod, hs_src) + lookup_node hs_src mod = Map.lookup (mod, hs_src) node_map lookup_key :: HscSource -> ModuleName -> Maybe Int lookup_key hs_src mod = fmap summaryNodeKey (lookup_node hs_src mod) node_map :: NodeMap SummaryNode - node_map = listToFM [ ((moduleName (ms_mod s), ms_hsc_src s), node) - | node@(s, _, _) <- nodes ] + node_map = Map.fromList [ ((moduleName (ms_mod s), ms_hsc_src s), node) + | node@(s, _, _) <- nodes ] -- We use integers as the keys for the SCC algorithm nodes :: [SummaryNode] @@ -1870,16 +1872,16 @@ moduleGraphNodes drop_hs_boot_nodes summaries = (graphFromEdgedVertices nodes, l type NodeKey = (ModuleName, HscSource) -- The nodes of the graph are -type NodeMap a = FiniteMap NodeKey a -- keyed by (mod, src_file_type) pairs +type NodeMap a = Map NodeKey a -- keyed by (mod, src_file_type) pairs msKey :: ModSummary -> NodeKey msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (moduleName mod,boot) mkNodeMap :: [ModSummary] -> NodeMap ModSummary -mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries] +mkNodeMap summaries = Map.fromList [ (msKey s, s) | s <- summaries] nodeMapElts :: NodeMap a -> [a] -nodeMapElts = eltsFM +nodeMapElts = Map.elems -- | If there are {-# SOURCE #-} imports between strongly connected -- components in the topological sort, then those imports can @@ -1984,7 +1986,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots -- for those mentioned in the visited set loop [] done = return (concat (nodeMapElts done)) loop ((wanted_mod, is_boot) : ss) done - | Just summs <- lookupFM done key + | Just summs <- Map.lookup key done = if isSingleton summs then loop ss done else @@ -1995,13 +1997,15 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots Nothing excl_mods case mb_s of Nothing -> loop ss done - Just s -> loop (msDeps s ++ ss) (addToFM done key [s]) + Just s -> loop (msDeps s ++ ss) (Map.insert key [s] done) where key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile) +-- XXX Does the (++) here need to be flipped? mkRootMap :: [ModSummary] -> NodeMap [ModSummary] -mkRootMap summaries = addListToFM_C (++) emptyFM - [ (msKey s, [s]) | s <- summaries ] +mkRootMap summaries = Map.insertListWith (flip (++)) + [ (msKey s, [s]) | s <- summaries ] + Map.empty msDeps :: ModSummary -> [(Located ModuleName, IsBootInterface)] -- (msDeps s) returns the dependencies of the ModSummary s. @@ -2146,7 +2150,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) | wanted_mod `elem` excl_mods = return Nothing - | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src) + | Just old_summary <- Map.lookup (wanted_mod, hsc_src) old_summary_map = do -- Find its new timestamp; all the -- ModSummaries in the old map have valid ml_hs_files let location = ms_location old_summary diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 5c41f68e85..bc9c9eef8f 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -140,7 +140,6 @@ import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) import BasicTypes ( IPName, defaultFixity, WarningTxt(..) ) import OptimizationFuel ( OptFuelState ) import IfaceSyn -import FiniteMap ( FiniteMap ) import CoreSyn ( CoreRule ) import Maybes ( orElse, expectJust, catMaybes ) import Outputable @@ -162,6 +161,7 @@ import System.Time ( ClockTime ) import Data.IORef import Data.Array ( Array, array ) import Data.List +import Data.Map (Map) import Control.Monad ( mplus, guard, liftM, when ) import Exception \end{code} @@ -1851,7 +1851,7 @@ data NameCache type OrigNameCache = ModuleEnv (OccEnv Name) -- | Module-local cache of implicit parameter 'OccName's given 'Name's -type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name) +type OrigIParamCache = Map (IPName OccName) (IPName Name) \end{code} diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 06cd573bc9..a940f99121 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -41,7 +41,6 @@ import StaticFlags import Config ( cProjectVersion ) import Name ( Name, nameModule_maybe ) import UniqFM -import FiniteMap import Module import Util import Panic @@ -60,6 +59,9 @@ import System.Directory import System.FilePath import Control.Monad import Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import qualified FiniteMap as Map import qualified Data.Set as Set -- --------------------------------------------------------------------------- @@ -126,9 +128,9 @@ data PackageState = PackageState { -- | A PackageConfigMap maps a 'PackageId' to a 'PackageConfig' type PackageConfigMap = UniqFM PackageConfig -type InstalledPackageIdMap = FiniteMap InstalledPackageId PackageId +type InstalledPackageIdMap = Map InstalledPackageId PackageId -type InstalledPackageIndex = FiniteMap InstalledPackageId PackageConfig +type InstalledPackageIndex = Map InstalledPackageId PackageConfig emptyPackageConfigMap :: PackageConfigMap emptyPackageConfigMap = emptyUFM @@ -331,7 +333,7 @@ selectPackages :: (PackageConfig -> Bool) -> [PackageConfig] selectPackages matches pkgs unusable = let (ps,rest) = partition matches pkgs - reasons = [ (p, lookupFM unusable (installedPackageId p)) + reasons = [ (p, Map.lookup (installedPackageId p) unusable) | p <- ps ] in if all (isJust.snd) reasons @@ -493,7 +495,7 @@ data UnusablePackageReason | MissingDependencies [InstalledPackageId] | ShadowedBy InstalledPackageId -type UnusablePackages = FiniteMap InstalledPackageId UnusablePackageReason +type UnusablePackages = Map InstalledPackageId UnusablePackageReason pprReason :: SDoc -> UnusablePackageReason -> SDoc pprReason pref reason = case reason of @@ -507,7 +509,7 @@ pprReason pref reason = case reason of pref <+> ptext (sLit "shadowed by package ") <> text (display ipid) reportUnusable :: DynFlags -> UnusablePackages -> IO () -reportUnusable dflags pkgs = mapM_ report (fmToList pkgs) +reportUnusable dflags pkgs = mapM_ report (Map.toList pkgs) where report (ipid, reason) = debugTraceMsg dflags 2 $ @@ -524,17 +526,18 @@ reportUnusable dflags pkgs = mapM_ report (fmToList pkgs) -- satisfied until no more can be added. -- findBroken :: [PackageConfig] -> UnusablePackages -findBroken pkgs = go [] emptyFM pkgs +findBroken pkgs = go [] Map.empty pkgs where go avail ipids not_avail = case partitionWith (depsAvailable ipids) not_avail of ([], not_avail) -> - listToFM [ (installedPackageId p, MissingDependencies deps) - | (p,deps) <- not_avail ] + Map.fromList [ (installedPackageId p, MissingDependencies deps) + | (p,deps) <- not_avail ] (new_avail, not_avail) -> go (new_avail ++ avail) new_ipids (map fst not_avail) - where new_ipids = addListToFM ipids + where new_ipids = Map.insertList [ (installedPackageId p, p) | p <- new_avail ] + ipids depsAvailable :: InstalledPackageIndex -> PackageConfig @@ -542,7 +545,7 @@ findBroken pkgs = go [] emptyFM pkgs depsAvailable ipids pkg | null dangling = Left pkg | otherwise = Right (pkg, dangling) - where dangling = filter (not . (`elemFM` ipids)) (depends pkg) + where dangling = filter (not . (`Map.member` ipids)) (depends pkg) -- ----------------------------------------------------------------------------- -- Eliminate shadowed packages, giving the user some feedback @@ -554,7 +557,7 @@ findBroken pkgs = go [] emptyFM pkgs shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages shadowPackages pkgs preferred = let (shadowed,_) = foldl check ([],emptyUFM) pkgs - in listToFM shadowed + in Map.fromList shadowed where check (shadowed,pkgmap) pkg | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg) @@ -574,7 +577,7 @@ shadowPackages pkgs preferred -- ----------------------------------------------------------------------------- ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages -ignorePackages flags pkgs = listToFM (concatMap doit flags) +ignorePackages flags pkgs = Map.fromList (concatMap doit flags) where doit (IgnorePackage str) = case partition (matchingStr str) pkgs of @@ -590,13 +593,13 @@ ignorePackages flags pkgs = listToFM (concatMap doit flags) depClosure :: InstalledPackageIndex -> [InstalledPackageId] -> [InstalledPackageId] -depClosure index ipids = closure emptyFM ipids +depClosure index ipids = closure Map.empty ipids where - closure set [] = keysFM set + closure set [] = Map.keys set closure set (ipid : ipids) - | ipid `elemFM` set = closure set ipids - | Just p <- lookupFM index ipid = closure (addToFM set ipid p) - (depends p ++ ipids) + | ipid `Map.member` set = closure set ipids + | Just p <- Map.lookup ipid index = closure (Map.insert ipid p set) + (depends p ++ ipids) | otherwise = closure set ipids -- ----------------------------------------------------------------------------- @@ -673,7 +676,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do where pid = installedPackageId p -- XXX this is just a variant of nub - ipid_map = listToFM [ (installedPackageId p, p) | p <- pkgs0 ] + ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ] ipid_selected = depClosure ipid_map [ InstalledPackageId i | ExposePackageId i <- flags ] @@ -686,9 +689,9 @@ mkPackageState dflags pkgs0 preload0 this_package = do ignored = ignorePackages ignore_flags pkgs0_unique - pkgs0' = filter (not . (`elemFM` (plusFM shadowed ignored)) . installedPackageId) pkgs0_unique + pkgs0' = filter (not . (`Map.member` (Map.union shadowed ignored)) . installedPackageId) pkgs0_unique broken = findBroken pkgs0' - unusable = shadowed `plusFM` ignored `plusFM` broken + unusable = shadowed `Map.union` ignored `Map.union` broken reportUnusable dflags unusable @@ -697,7 +700,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do -- (-package, -hide-package, -ignore-package, -hide-all-packages). -- pkgs1 <- foldM (applyPackageFlag unusable) pkgs0_unique other_flags - let pkgs2 = filter (not . (`elemFM` unusable) . installedPackageId) pkgs1 + let pkgs2 = filter (not . (`Map.member` unusable) . installedPackageId) pkgs1 -- Here we build up a set of the packages mentioned in -package -- flags on the command line; these are called the "preload" @@ -719,12 +722,12 @@ mkPackageState dflags pkgs0 preload0 this_package = do let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs4 - ipid_map = listToFM [ (installedPackageId p, packageConfigId p) - | p <- pkgs4 ] + ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p) + | p <- pkgs4 ] lookupIPID ipid@(InstalledPackageId str) - | Just pid <- lookupFM ipid_map ipid = return pid - | otherwise = missingPackageErr str + | Just pid <- Map.lookup ipid ipid_map = return pid + | otherwise = missingPackageErr str preload2 <- mapM lookupIPID preload1 @@ -890,7 +893,7 @@ getPreloadPackagesAnd dflags pkgids = -- Takes a list of packages, and returns the list with dependencies included, -- in reverse dependency order (a package appears before those it depends on). closeDeps :: PackageConfigMap - -> FiniteMap InstalledPackageId PackageId + -> Map InstalledPackageId PackageId -> [(PackageId, Maybe PackageId)] -> IO [PackageId] closeDeps pkg_map ipid_map ps = throwErr (closeDepsErr pkg_map ipid_map ps) @@ -901,14 +904,14 @@ throwErr m = case m of Succeeded r -> return r closeDepsErr :: PackageConfigMap - -> FiniteMap InstalledPackageId PackageId + -> Map InstalledPackageId PackageId -> [(PackageId,Maybe PackageId)] -> MaybeErr Message [PackageId] closeDepsErr pkg_map ipid_map ps = foldM (add_package pkg_map ipid_map) [] ps -- internal helper add_package :: PackageConfigMap - -> FiniteMap InstalledPackageId PackageId + -> Map InstalledPackageId PackageId -> [PackageId] -> (PackageId,Maybe PackageId) -> MaybeErr Message [PackageId] @@ -924,7 +927,7 @@ add_package pkg_db ipid_map ps (p, mb_parent) return (p : ps') where add_package_ipid ps ipid@(InstalledPackageId str) - | Just pid <- lookupFM ipid_map ipid + | Just pid <- Map.lookup ipid ipid_map = add_package pkg_db ipid_map ps (pid, Just p) | otherwise = Failed (missingPackageMsg str <> missingDependencyMsg mb_parent) diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 12b73d3bf2..1693aa06a9 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -45,7 +45,6 @@ import ErrUtils import Panic import Util import DynFlags -import FiniteMap import Exception import Data.IORef @@ -58,6 +57,7 @@ import System.IO.Error as IO import System.Directory import Data.Char import Data.List +import qualified Data.Map as Map #ifndef mingw32_HOST_OS import qualified System.Posix.Internals @@ -472,8 +472,8 @@ cleanTempDirs dflags = unless (dopt Opt_KeepTmpFiles dflags) $ do let ref = dirsToClean dflags ds <- readIORef ref - removeTmpDirs dflags (eltsFM ds) - writeIORef ref emptyFM + removeTmpDirs dflags (Map.elems ds) + writeIORef ref Map.empty cleanTempFiles :: DynFlags -> IO () cleanTempFiles dflags @@ -515,7 +515,7 @@ getTempDir :: DynFlags -> IO FilePath getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) = do let ref = dirsToClean dflags mapping <- readIORef ref - case lookupFM mapping tmp_dir of + case Map.lookup tmp_dir mapping of Nothing -> do x <- getProcessID let prefix = tmp_dir </> "ghc" ++ show x ++ "_" @@ -524,7 +524,7 @@ getTempDir dflags@(DynFlags{tmpDir=tmp_dir}) mkTempDir x = let dirname = prefix ++ show x in do createDirectory dirname - let mapping' = addToFM mapping tmp_dir dirname + let mapping' = Map.insert tmp_dir dirname mapping writeIORef ref mapping' debugTraceMsg dflags 2 (ptext (sLit "Created temporary directory:") <+> text dirname) return dirname |