X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=8d9273750e33b7d562c70801449d29754d114170;hb=f670c47f9f93ffd6d06b331cd40554cd5e92484c;hp=386eae8bf3f0707f20a4f79d3179548c0b95f655;hpb=aa0c0de94e25aa64139688f8e4c4ba51ddca6f54;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 386eae8..8d92737 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -257,29 +257,28 @@ getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) } getEps :: TcRnIf gbl lcl ExternalPackageState getEps = do { env <- getTopEnv; readMutVar (hsc_EPS env) } --- Updating the EPS. This should be an atomic operation. --- Note the delicate 'seq' which forces the EPS before putting it in the --- variable. Otherwise what happens is that we get --- write eps_var (....(unsafeRead eps_var)....) --- and if the .... is strict, that's obviously bottom. By forcing it beforehand --- we make the unsafeRead happen before we update the variable. - +-- | Update the external package state. Returns the second result of the +-- modifier function. +-- +-- This is an atomic operation and forces evaluation of the modified EPS in +-- order to avoid space leaks. updateEps :: (ExternalPackageState -> (ExternalPackageState, a)) -> TcRnIf gbl lcl a -updateEps upd_fn = do { traceIf (text "updating EPS") - ; eps_var <- getEpsVar - ; eps <- readMutVar eps_var - ; let { (eps', val) = upd_fn eps } - ; seq eps' (writeMutVar eps_var eps') - ; return val } +updateEps upd_fn = do + traceIf (text "updating EPS") + eps_var <- getEpsVar + atomicUpdMutVar' eps_var upd_fn +-- | Update the external package state. +-- +-- This is an atomic operation and forces evaluation of the modified EPS in +-- order to avoid space leaks. updateEps_ :: (ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl () -updateEps_ upd_fn = do { traceIf (text "updating EPS_") - ; eps_var <- getEpsVar - ; eps <- readMutVar eps_var - ; let { eps' = upd_fn eps } - ; seq eps' (writeMutVar eps_var eps') } +updateEps_ upd_fn = do + traceIf (text "updating EPS_") + eps_var <- getEpsVar + atomicUpdMutVar' eps_var (\eps -> (upd_fn eps, ())) getHpt :: TcRnIf gbl lcl HomePackageTable getHpt = do { env <- getTopEnv; return (hsc_HPT env) }