X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=8f22af887b411b9d1949b15652d654a2f099890a;hb=182edd420fe8d5ec0d12fcabaec7d13416a77cd6;hp=4d7658ec93f82693a0744bec4eb06bc601b664e7;hpb=af95321493a31cbaf34170fd9ab5e9c65a416506;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 4d7658e..8f22af8 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -39,6 +39,7 @@ import Config
 import StaticFlags
 import Linker
 import Util
+import FastString
 
 #ifndef mingw32_HOST_OS
 import System.Posix
@@ -88,9 +89,9 @@ import System.Posix.Internals ( setNonBlockingFD )
 ghciWelcomeMsg =
  "   ___         ___ _\n"++
  "  / _ \\ /\\  /\\/ __(_)\n"++
- " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
+ " / /_\\// /_/ / /  | |    GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
+ "/ /_\\\\/ __  / /___| |    http://www.haskell.org/ghc/\n"++
+ "\\____/\\/ /_/\\____/|_|    Type :? for help.\n"
 
 type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
 cmdName (n,_,_,_) = n
@@ -450,9 +451,9 @@ mkPrompt toplevs exports resumes prompt
         f [] = empty
     
         perc_s
-          | (span,_,_):rest <- resumes 
+          | eval:rest <- resumes 
           = (if not (null rest) then text "... " else empty)
-            <> brackets (ppr span) <+> modules_prompt
+            <> brackets (ppr (evalSpan eval)) <+> modules_prompt
           | otherwise
           = modules_prompt
 
@@ -520,13 +521,13 @@ runStmt stmt
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
 	     	     GHC.runStmt session stmt
-      switchOnRunResult result
+      switchOnRunResult stmt result
 
-switchOnRunResult :: GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
-switchOnRunResult GHC.RunFailed = return Nothing
-switchOnRunResult (GHC.RunException e) = throw e
-switchOnRunResult (GHC.RunOk names) = return $ Just (False,names)
-switchOnRunResult (GHC.RunBreak threadId names info resume) = do
+switchOnRunResult :: String -> GHC.RunResult -> GHCi (Maybe (Bool,[Name]))
+switchOnRunResult stmt GHC.RunFailed = return Nothing
+switchOnRunResult stmt (GHC.RunException e) = throw e
+switchOnRunResult stmt (GHC.RunOk names) = return $ Just (False,names)
+switchOnRunResult stmt (GHC.RunBreak threadId names info resume) = do
    session <- getSession
    Just mod_info <- io $ GHC.getModuleInfo session (GHC.breakInfo_module info) 
    let modBreaks  = GHC.modInfoModBreaks mod_info
@@ -536,7 +537,10 @@ switchOnRunResult (GHC.RunBreak threadId names info resume) = do
    let location = ticks ! GHC.breakInfo_number info
    printForUser $ ptext SLIT("Stopped at") <+> ppr location
 
-   pushResume location threadId resume
+   pushResume EvalInProgress{ evalStmt = stmt,
+                              evalSpan = location,
+                              evalThreadId = threadId,
+                              evalResumeHandle = resume }
 
    -- run the command set with ":set stop <cmd>"
    st <- getGHCiState
@@ -1149,9 +1153,11 @@ showBkptTable = do
 showContext :: GHCi ()
 showContext = do
    st <- getGHCiState
-   printForUser $ vcat (map pp_resume (resume st))
+   printForUser $ vcat (map pp_resume (reverse (resume st)))
   where
-   pp_resume (span, _, _) = ptext SLIT("Stopped at") <+> ppr span
+   pp_resume eval =
+        ptext SLIT("--> ") <> text (evalStmt eval)
+        $$ nest 2 (ptext SLIT("Stopped at") <+> ppr (evalSpan eval))
 
 -- -----------------------------------------------------------------------------
 -- Completion
@@ -1385,11 +1391,11 @@ doContinue actionBeforeCont = do
       Nothing -> do 
          io $ putStrLn "There is no computation running."
          return False
-      Just (_,_,handle) -> do
+      Just eval -> do
          io $ actionBeforeCont
          session <- getSession
-         runResult <- io $ GHC.resume session handle
-         names <- switchOnRunResult runResult
+         runResult <- io $ GHC.resume session (evalResumeHandle eval)
+         names <- switchOnRunResult (evalStmt eval) runResult
          finishEvalExpr names
          return False
 
@@ -1399,7 +1405,7 @@ abandonCmd "" = do
    case mb_res of
       Nothing -> do 
          io $ putStrLn "There is no computation running."
-      Just (span,_,_) ->
+      Just eval ->
          return ()
          -- the prompt will change to indicate the new context
 
@@ -1454,7 +1460,8 @@ breakSwitch session args@(arg1:rest)
                else do
             if GHC.isGoodSrcLoc loc
                then findBreakAndSet (GHC.nameModule n) $ 
-                         findBreakByCoord (GHC.srcLocLine loc, 
+                         findBreakByCoord (Just (GHC.srcLocFile loc))
+                                          (GHC.srcLocLine loc, 
                                            GHC.srcLocCol loc)
                else noCanDo $ text "can't find its location: " <>
                               ppr loc
@@ -1481,7 +1488,7 @@ breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
 breakByModuleLine mod line args
    | [] <- args = findBreakAndSet mod $ findBreakByLine line
    | [col] <- args, all isDigit col =
-        findBreakAndSet mod $ findBreakByCoord (line, read col)
+        findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
    | otherwise = io $ putStrLn "Invalid arguments to :break"
 
 findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
@@ -1532,8 +1539,9 @@ findBreakByLine line arr
         (complete,incomplete) = partition ends_here starts_here
             where ends_here (nm,span) = GHC.srcSpanEndLine span == line
 
-findBreakByCoord :: (Int,Int) -> TickArray -> Maybe (BreakIndex,SrcSpan)
-findBreakByCoord (line, col) arr
+findBreakByCoord :: Maybe FastString -> (Int,Int) -> TickArray
+                 -> Maybe (BreakIndex,SrcSpan)
+findBreakByCoord mb_file (line, col) arr
   | not (inRange (bounds arr) line) = Nothing
   | otherwise =
     listToMaybe (sortBy rightmost contains)
@@ -1541,7 +1549,13 @@ findBreakByCoord (line, col) arr
         ticks = arr ! line
 
         -- the ticks that span this coordinate
-        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col) ]
+        contains = [ tick | tick@(nm,span) <- ticks, span `spans` (line,col),
+                            is_correct_file span ]
+
+        is_correct_file span
+                 | Just f <- mb_file = GHC.srcSpanFile span == f
+                 | otherwise         = True
+
 
 leftmost_smallest  (_,a) (_,b) = a `compare` b
 leftmost_largest   (_,a) (_,b) = (GHC.srcSpanStart a `compare` GHC.srcSpanStart b)
@@ -1561,7 +1575,7 @@ listCmd str = do
    st <- getGHCiState
    case resume st of
       []  -> printForUser $ text "not stopped at a breakpoint; nothing to list"
-      (span,_,_):_ -> io $ listAround span True
+      eval:_ -> io $ listAround (evalSpan eval) True
 
 -- | list a section of a source file around a particular SrcSpan.
 -- If the highlight flag is True, also highlight the span using