Put a newtype wrapper around ModuleEnv

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 2eebf65..77aa5ad 100644 (file)
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -58,7 +58,8 @@ module Module
        extendModuleEnvList_C, plusModuleEnv_C,
        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
-       moduleEnvKeys, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv,
+       moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+        unitModuleEnv, isEmptyModuleEnv,
         foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
 
        -- * ModuleName mappings
@@ -342,51 +343,71 @@ mainPackageId        = fsToPackageId (fsLit "main")
 
 \begin{code}
 -- | A map keyed off of 'Module's
-type ModuleEnv elt = FiniteMap Module elt
-
-emptyModuleEnv       :: ModuleEnv a
-mkModuleEnv          :: [(Module, a)] -> ModuleEnv a
-unitModuleEnv        :: Module -> a -> ModuleEnv a
-extendModuleEnv      :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv_C    :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
-plusModuleEnv        :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-extendModuleEnvList  :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-extendModuleEnvList_C  :: (a->a->a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-                  
-delModuleEnvList     :: ModuleEnv a -> [Module] -> ModuleEnv a
-delModuleEnv         :: ModuleEnv a -> Module -> ModuleEnv a
-plusModuleEnv_C      :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-mapModuleEnv         :: (a -> b) -> ModuleEnv a -> ModuleEnv b
-moduleEnvKeys        :: ModuleEnv a -> [Module]
-moduleEnvElts        :: ModuleEnv a -> [a]
-                  
-isEmptyModuleEnv     :: ModuleEnv a -> Bool
-lookupModuleEnv      :: ModuleEnv a -> Module     -> Maybe a
+newtype ModuleEnv elt = ModuleEnv (FiniteMap Module elt)
+
+filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
+filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)
+
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+elemModuleEnv m (ModuleEnv e) = elemFM m e
+
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)
+
+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)
+
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)
+
+extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
+                      -> ModuleEnv a
+extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)
+
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)
+
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)
+
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)
+
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupModuleEnv (ModuleEnv e) m = lookupFM e m
+
 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
-elemModuleEnv        :: Module -> ModuleEnv a -> Bool
-foldModuleEnv        :: (a -> b -> b) -> b -> ModuleEnv a -> b
-filterModuleEnv      :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
-
-filterModuleEnv f   = filterFM (\_ v -> f v)
-elemModuleEnv       = elemFM
-extendModuleEnv     = addToFM
-extendModuleEnv_C   = addToFM_C
-extendModuleEnvList = addListToFM
-extendModuleEnvList_C = addListToFM_C
-plusModuleEnv_C     = plusFM_C
-delModuleEnvList    = delListFromFM
-delModuleEnv        = delFromFM
-plusModuleEnv       = plusFM
-lookupModuleEnv     = lookupFM
-lookupWithDefaultModuleEnv = lookupWithDefaultFM
-mapModuleEnv f      = mapFM (\_ v -> f v)
-mkModuleEnv         = listToFM
-emptyModuleEnv      = emptyFM
-moduleEnvKeys       = keysFM
-moduleEnvElts       = eltsFM
-unitModuleEnv       = unitFM
-isEmptyModuleEnv    = isEmptyFM
-foldModuleEnv f     = foldFM (\_ v -> f v)
+lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m
+
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)
+
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+mkModuleEnv xs = ModuleEnv (listToFM xs)
+
+emptyModuleEnv :: ModuleEnv a
+emptyModuleEnv = ModuleEnv emptyFM
+
+moduleEnvKeys :: ModuleEnv a -> [Module]
+moduleEnvKeys (ModuleEnv e) = keysFM e
+
+moduleEnvElts :: ModuleEnv a -> [a]
+moduleEnvElts (ModuleEnv e) = eltsFM e
+
+moduleEnvToList :: ModuleEnv a -> [(Module, a)]
+moduleEnvToList (ModuleEnv e) = fmToList e
+
+unitModuleEnv :: Module -> a -> ModuleEnv a
+unitModuleEnv m x = ModuleEnv (unitFM m x)
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e
+
+foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
+foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
 \end{code}
 
 \begin{code}

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 7b30a19..4de3a6f 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -915,7 +915,8 @@ mkIfaceExports :: [AvailInfo]
                   -- Group by module and sort by occurrence
 mkIfaceExports exports
   = [ (mod, eltsFM avails)
-    | (mod, avails) <- sortBy (stableModuleCmp `on` fst) (fmToList groupFM)
+    | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
+                              (moduleEnvToList groupFM)
                        -- NB. the fmToList is in a random order,
                        -- because Ord Module is not a predictable
                        -- ordering.  Hence we perform a final sort

diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs
index 17299fb..ad163f2 100644 (file)
--- a/compiler/main/Finder.lhs
+++ b/compiler/main/Finder.lhs
@@ -78,7 +78,7 @@ flushFinderCaches hsc_env = do
 
 flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
 flushModLocationCache this_pkg ref = do
-  atomicModifyIORef ref $ \fm -> (filterFM is_ext fm, ())
+  atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
   _ <- evaluate =<< readIORef ref
   return ()
   where is_ext mod _ | modulePackageId mod /= this_pkg = True
@@ -90,7 +90,7 @@ addToFinderCache ref key val =
 
 addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
 addToModLocationCache ref key val =
-  atomicModifyIORef ref $ \c -> (addToFM c key val, ())
+  atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
 
 removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
 removeFromFinderCache ref key =
@@ -98,7 +98,7 @@ removeFromFinderCache ref key =
 
 removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
 removeFromModLocationCache ref key =
-  atomicModifyIORef ref $ \c -> (delFromFM c key, ())
+  atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
 
 lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
 lookupFinderCache ref key = do 
@@ -109,7 +109,7 @@ lookupModLocationCache :: IORef ModLocationCache -> Module
                        -> IO (Maybe ModLocation)
 lookupModLocationCache ref key = do
    c <- readIORef ref
-   return $! lookupFM c key
+   return $! lookupModuleEnv c key
 
 -- -----------------------------------------------------------------------------
 -- The two external entry points