X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FLinker.lhs;h=bce79c257f011d546e8c516d9be517de8675887a;hb=43d903cfaafb0b41242af128c7ddbf0b649f63bd;hp=76e9f318c99c8017ab3ed7ed0fceac3b0b9ba26b;hpb=9c54ee0c9e25617b2a9ad4cdd9d3a6354e2edc0f;p=ghc-hetmet.git diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 76e9f31..bce79c2 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -223,7 +223,7 @@ dataConInfoPtrToName x = do offsetToString <- peek $ ptr `plusPtr` (- wORD_SIZE) return $ (ptr `plusPtr` stdInfoTableSizeB) `plusPtr` (fromIntegral (offsetToString :: StgWord)) #else - peek $ intPtrToPtr $ (ptrToIntPtr ptr) + stdInfoTableSizeB + peek $ intPtrToPtr $ (ptrToIntPtr ptr) + fromIntegral stdInfoTableSizeB #endif -- parsing names is a little bit fiddly because we have a string in the form: @@ -278,17 +278,31 @@ linkDependencies hsc_env span needed_mods = do linkModules dflags lnks +-- | Temporarily extend the linker state. + withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a withExtendedLinkEnv new_env action = bracket set_new_env reset_old_env (const action) - where set_new_env = do pls <- readIORef v_PersistentLinkerState - let new_closure_env = extendClosureEnv (closure_env pls) new_env - new_pls = pls { closure_env = new_closure_env } - writeIORef v_PersistentLinkerState new_pls - return (closure_env pls) - reset_old_env env = modifyIORef v_PersistentLinkerState (\pls -> pls{ closure_env = env }) + where set_new_env = do + pls <- readIORef v_PersistentLinkerState + let new_closure_env = extendClosureEnv (closure_env pls) new_env + new_pls = pls { closure_env = new_closure_env } + writeIORef v_PersistentLinkerState new_pls + return (closure_env pls) + + -- Remember that the linker state might be side-effected + -- during the execution of the IO action, and we don't want to + -- lose those changes (we might have linked a new module or + -- package), so the reset action only removes the names we + -- added earlier. + reset_old_env env = do + modifyIORef v_PersistentLinkerState $ \pls -> + let cur = closure_env pls + new = delListFromNameEnv cur (map fst new_env) + in + pls{ closure_env = new } -- filterNameMap removes from the environment all entries except -- those for a given set of modules;