projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add the RTS library path to the library search path
[ghc-hetmet.git]
/
compiler
/
main
/
Finder.lhs
diff --git
a/compiler/main/Finder.lhs
b/compiler/main/Finder.lhs
index
21d7feb
..
29e1fb6
100644
(file)
--- a/
compiler/main/Finder.lhs
+++ b/
compiler/main/Finder.lhs
@@
-34,13
+34,13
@@
import Util
import PrelNames ( gHC_PRIM )
import DynFlags
import Outputable
import PrelNames ( gHC_PRIM )
import DynFlags
import Outputable
-import FiniteMap
-import LazyUniqFM
+import UniqFM
import Maybes ( expectJust )
import Maybes ( expectJust )
+import Exception ( evaluate )
import Distribution.Text
import Distribution.Package hiding (PackageId)
import Distribution.Text
import Distribution.Package hiding (PackageId)
-import Data.IORef ( IORef, writeIORef, readIORef, modifyIORef )
+import Data.IORef ( IORef, writeIORef, readIORef, atomicModifyIORef )
import System.Directory
import System.FilePath
import Control.Monad
import System.Directory
import System.FilePath
import Control.Monad
@@
-67,6
+67,7
@@
type BaseName = String -- Basename of file
-- assumed to not move around during a session.
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env = do
-- assumed to not move around during a session.
flushFinderCaches :: HscEnv -> IO ()
flushFinderCaches hsc_env = do
+ -- Ideally the update to both caches be a single atomic operation.
writeIORef fc_ref emptyUFM
flushModLocationCache this_pkg mlc_ref
where
writeIORef fc_ref emptyUFM
flushModLocationCache this_pkg mlc_ref
where
@@
-76,23
+77,27
@@
flushFinderCaches hsc_env = do
flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
flushModLocationCache this_pkg ref = do
flushModLocationCache :: PackageId -> IORef ModLocationCache -> IO ()
flushModLocationCache this_pkg ref = do
- fm <- readIORef ref
- writeIORef ref $! filterFM is_ext fm
+ atomicModifyIORef ref $ \fm -> (filterModuleEnv is_ext fm, ())
+ _ <- evaluate =<< readIORef ref
return ()
where is_ext mod _ | modulePackageId mod /= this_pkg = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
return ()
where is_ext mod _ | modulePackageId mod /= this_pkg = True
| otherwise = False
addToFinderCache :: IORef FinderCache -> ModuleName -> FindResult -> IO ()
-addToFinderCache ref key val = modifyIORef ref $ \c -> addToUFM c key val
+addToFinderCache ref key val =
+ atomicModifyIORef ref $ \c -> (addToUFM c key val, ())
addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
addToModLocationCache :: IORef ModLocationCache -> Module -> ModLocation -> IO ()
-addToModLocationCache ref key val = modifyIORef ref $ \c -> addToFM c key val
+addToModLocationCache ref key val =
+ atomicModifyIORef ref $ \c -> (extendModuleEnv c key val, ())
removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
removeFromFinderCache :: IORef FinderCache -> ModuleName -> IO ()
-removeFromFinderCache ref key = modifyIORef ref $ \c -> delFromUFM c key
+removeFromFinderCache ref key =
+ atomicModifyIORef ref $ \c -> (delFromUFM c key, ())
removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
removeFromModLocationCache :: IORef ModLocationCache -> Module -> IO ()
-removeFromModLocationCache ref key = modifyIORef ref $ \c -> delFromFM c key
+removeFromModLocationCache ref key =
+ atomicModifyIORef ref $ \c -> (delModuleEnv c key, ())
lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
lookupFinderCache ref key = do
lookupFinderCache :: IORef FinderCache -> ModuleName -> IO (Maybe FindResult)
lookupFinderCache ref key = do
@@
-103,7
+108,7
@@
lookupModLocationCache :: IORef ModLocationCache -> Module
-> IO (Maybe ModLocation)
lookupModLocationCache ref key = do
c <- readIORef ref
-> IO (Maybe ModLocation)
lookupModLocationCache ref key = do
c <- readIORef ref
- return $! lookupFM c key
+ return $! lookupModuleEnv c key
-- -----------------------------------------------------------------------------
-- The two external entry points
-- -----------------------------------------------------------------------------
-- The two external entry points