X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=9afedaed421dd49cbe0fd9374fd765164396e049;hb=8fd85c9d692f91a5b565bb0d54050c2ce6ac6ae2;hp=6e6580e2487cd727e74099180a3d15c33e9fabca;hpb=0c45d82423fcff64b43b95ab4882b26e7de560bf;p=ghc-hetmet.git

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 6e6580e..9afedae 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -64,6 +64,7 @@ import ByteCodeInstr
 import Linker
 import DynFlags
 import Unique
+import UniqSupply
 import Module
 import Panic
 import UniqFM
@@ -315,7 +316,7 @@ foreign import ccall "&rts_breakpoint_io_action"
 -- thread.  ToDo: we might want a way to continue even if the target
 -- thread doesn't die when it receives the exception... "this thread
 -- is not responding".
--- sandboxIO :: MVar Status -> IO [HValue] -> IO Status
+sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
 sandboxIO dflags statusMVar thing = 
   withInterruptsSentTo 
         (forkIO (do res <- Exception.try (rethrow dflags thing)
@@ -330,7 +331,7 @@ sandboxIO dflags statusMVar thing =
 -- to :continue twice, which looks strange).  So if the exception is
 -- not "Interrupted", we unset the exception flag before throwing.
 --
--- rethrow :: IO a -> IO a
+rethrow :: DynFlags -> IO a -> IO a
 rethrow dflags io = Exception.catch io $ \e -> do -- NB. not catchDyn
                 case e of
                    -- If -fbreak-on-error, we break unconditionally,
@@ -582,7 +583,13 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
   where
    mkNewId :: OccName -> Id -> IO Id
    mkNewId occ id = do
-     let uniq = idUnique id
+     us <- mkSplitUniqSupply 'I'
+        -- we need a fresh Unique for each Id we bind, because the linker
+        -- state is single-threaded and otherwise we'd spam old bindings
+        -- whenever we stop at a breakpoint.  The InteractveContext is properly
+        -- saved/restored, but not the linker state.  See #1743, test break026.
+     let 
+         uniq = uniqFromSupply us
          loc = nameSrcSpan (idName id)
          name = mkInternalName uniq occ loc
          ty = idType id