Store a SrcSpan instead of a SrcLoc inside a Name

[ghc-hetmet.git] / compiler / main / InteractiveEval.hs

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 26d251d..5106d34 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -451,7 +451,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
    -- _result in scope at any time.
    let result_fs = FSLIT("_result")
        result_name = mkInternalName (getUnique result_fs)
-                          (mkVarOccFS result_fs) (srcSpanStart span)
+                          (mkVarOccFS result_fs) span
        result_id   = Id.mkLocalId result_name result_ty
 
    -- for each Id we're about to bind in the local envt:
@@ -478,7 +478,7 @@ bindLocalsAtBreakpoint hsc_env apStack info = do
    mkNewId :: OccName -> Id -> IO Id
    mkNewId occ id = do
      let uniq = idUnique id
-         loc = nameSrcLoc (idName id)
+         loc = nameSrcSpan (idName id)
          name = mkInternalName uniq occ loc
          ty = idType id
          new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
@@ -522,8 +522,9 @@ abandon (Session ref) = do
        resume = ic_resume ic
    case resume of
       []    -> return False
-      _:rs  -> do
+      r:rs  -> do 
          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = rs } }
+         abandon_ r
          return True
 
 abandonAll :: Session -> IO Bool
@@ -532,11 +533,26 @@ abandonAll (Session ref) = do
    let ic = hsc_IC hsc_env
        resume = ic_resume ic
    case resume of
-      []    -> return False
-      _:rs  -> do
+      []  -> return False
+      rs  -> do 
          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = [] } }
+         mapM_ abandon_ rs
          return True
 
+-- when abandoning a computation we have to 
+--      (a) kill the thread with an async exception, so that the 
+--          computation itself is stopped, and
+--      (b) fill in the MVar.  This step is necessary because any
+--          thunks that were under evaluation will now be updated
+--          with the partial computation, which still ends in takeMVar,
+--          so any attempt to evaluate one of these thunks will block
+--          unless we fill in the MVar.
+--  See test break010.
+abandon_ :: Resume -> IO ()
+abandon_ r = do
+  killThread (resumeThreadId r)
+  putMVar (resumeBreakMVar r) () 
+
 -- -----------------------------------------------------------------------------
 -- Bounded list, optimised for repeated cons