diff options
| author | Patrick Palka <patrick@parcs.ath.cx> | 2013-08-21 17:31:40 -0400 |
|---|---|---|
| committer | Patrick Palka <patrick@parcs.ath.cx> | 2013-08-26 22:21:16 -0400 |
| commit | db347943b860b7bede85fe4a94f0e79eada035ae (patch) | |
| tree | 7485489b8ceabda70f7e01b984abc068ca19e212 /compiler | |
| parent | 25f8cc8375068f8277eeaacc530248a7b33edaa1 (diff) | |
| download | haskell-db347943b860b7bede85fe4a94f0e79eada035ae.tar.gz | |
TcEnv: Make mkWrapperName deterministic and thread-safe
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/main/DynFlags.hs | 4 | ||||
| -rw-r--r-- | compiler/typecheck/TcEnv.lhs | 11 |
2 files changed, 10 insertions, 5 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index e69cccbaa7..cb7d43c3f0 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -748,7 +748,7 @@ data DynFlags = DynFlags { llvmVersion :: IORef Int, - nextWrapperNum :: IORef Int, + nextWrapperNum :: IORef (ModuleEnv Int), -- | Machine dependant flags (-m<blah> stuff) sseVersion :: Maybe (Int, Int), -- (major, minor) @@ -1211,7 +1211,7 @@ initDynFlags dflags = do refGeneratedDumps <- newIORef Set.empty refLlvmVersion <- newIORef 28 refRtldFlags <- newIORef Nothing - wrapperNum <- newIORef 0 + wrapperNum <- newIORef emptyModuleEnv canUseUnicodeQuotes <- do let enc = localeEncoding str = "‛’" (withCString enc str $ \cstr -> diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs index 058e84a22e..dde9797845 100644 --- a/compiler/typecheck/TcEnv.lhs +++ b/compiler/typecheck/TcEnv.lhs @@ -781,8 +781,10 @@ mkWrapperName what nameBase wrapperRef = nextWrapperNum dflags pkg = packageIdString (modulePackageId thisMod) mod = moduleNameString (moduleName thisMod) - wrapperNum <- liftIO $ readIORef wrapperRef - liftIO $ writeIORef wrapperRef (wrapperNum + 1) + wrapperNum <- liftIO $ atomicModifyIORef wrapperRef $ \mod_env -> + let num = lookupWithDefaultModuleEnv mod_env 0 thisMod + mod_env' = extendModuleEnv mod_env thisMod (num+1) + in (mod_env', num) let components = [what, show wrapperNum, pkg, mod, nameBase] return $ mkFastString $ zEncodeString $ intercalate ":" components @@ -795,6 +797,9 @@ generate are external names. This means that if a call to them ends up in an unfolding, then we can't alpha-rename them, and thus if the unique randomly changes from one compile to another then we get a spurious ABI change (#4012). + +The wrapper counter has to be per-module, not global, so that the number we end +up using is not dependent on the modules compiled before the current one. -} \end{code} @@ -844,4 +849,4 @@ This is really a staging error, because we can't run code involving 'x'. But in fact the type checker processes types first, so 'x' won't even be in the type envt when we look for it in $(foo x). So inside splices we report something missing from the type env as a staging error. -See Trac #5752 and #5795.
\ No newline at end of file +See Trac #5752 and #5795. |