Teach :history to show the name of the enclosing declaration

 together with src locs

Purely for convenience and user friendliness

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 22b8211..aacf8b3 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -464,7 +464,7 @@ mkPrompt = do
                    then return (brackets (ppr (GHC.resumeSpan r)) <> space)
                    else do
                         let hist = GHC.resumeHistory r !! (ix-1)
-                        span <- io $ GHC.getHistorySpan session hist
+                        span <- io$ GHC.getHistorySpan session hist
                         return (brackets (ppr (negate ix) <> char ':' 
                                           <+> ppr span) <> space)
   let
@@ -1647,8 +1647,13 @@ historyCmd arg
         let hist = GHC.resumeHistory r
             (took,rest) = splitAt num hist
         spans <- mapM (io . GHC.getHistorySpan s) took
-        let nums = map (printf "-%-3d:") [(1::Int)..]
-        printForUser (vcat (zipWith (<+>) (map text nums) (map ppr spans)))
+        let nums  = map (printf "-%-3d:") [(1::Int)..]
+        let names = map GHC.historyEnclosingDecl took
+        printForUser (vcat(zipWith3 
+                             (\x y z -> x <+> y <+> z) 
+                             (map text nums) 
+                             (map (ftext . occNameFS . nameOccName) names)
+                             (map (parens . ppr) spans)))
         io $ putStrLn $ if null rest then "<end of history>" else "..."
 
 backCmd :: String -> GHCi ()

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index a95c36c..506a839 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -84,7 +84,8 @@ module GHC (
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
-        History(historyBreakInfo), getHistorySpan, getHistoryModule,
+        History(historyBreakInfo, historyEnclosingDecl), 
+        GHC.getHistorySpan, getHistoryModule,
         getResumeContext,
         abandon, abandonAll,
         InteractiveEval.back,
@@ -1974,3 +1975,9 @@ findModule' hsc_env mod_name maybe_pkg =
                                        text "is not loaded"))
            err -> let msg = cannotFindModule dflags mod_name err in
                   throwDyn (CmdLineError (showSDoc msg))
+
+#ifdef GHCI
+getHistorySpan :: Session -> History -> IO SrcSpan
+getHistorySpan sess h = withSession sess $ \hsc_env -> 
+                          return$ InteractiveEval.getHistorySpan hsc_env h
+#endif
\ No newline at end of file

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 069a829..901dd63 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -70,6 +70,7 @@ import BasicTypes
 import Outputable
 
 import Data.Dynamic
+import Data.List (find)
 import Control.Monad
 import Foreign
 import Foreign.C
@@ -129,20 +130,47 @@ isStep _ = True
 data History
    = History {
         historyApStack   :: HValue,
-        historyBreakInfo :: BreakInfo
+        historyBreakInfo :: BreakInfo,
+        historyEnclosingDecl :: Name
+         -- ^^ A cache of the enclosing declaration, for convenience
    }
 
-getHistoryModule :: History -> Module 
+mkHistory :: HscEnv -> HValue -> BreakInfo -> History
+mkHistory hsc_env hval bi = let
+    h    = History hval bi decl
+    decl = findEnclosingDecl hsc_env (getHistoryModule h)
+                                     (getHistorySpan hsc_env h)
+    in h
+
+getHistoryModule :: History -> Module
 getHistoryModule = breakInfo_module . historyBreakInfo
 
-getHistorySpan :: Session -> History -> IO SrcSpan
-getHistorySpan s hist = withSession s $ \hsc_env -> do
-   let inf = historyBreakInfo hist 
+getHistorySpan :: HscEnv -> History -> SrcSpan
+getHistorySpan hsc_env hist =
+   let inf = historyBreakInfo hist
        num = breakInfo_number inf
-   case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
-       Just hmi -> return (modBreaks_locs (md_modBreaks (hm_details hmi)) ! num)
+   in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
+       Just hmi -> modBreaks_locs (md_modBreaks (hm_details hmi)) ! num
        _ -> panic "getHistorySpan"
 
+findEnclosingDecl :: HscEnv -> Module -> SrcSpan -> Name
+findEnclosingDecl hsc_env mod span =
+       case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of
+         Nothing -> panic "findEnclosingDecl"
+         Just hmi -> let
+                globals   = typeEnvIds (md_types (hm_details hmi))
+                Just decl = find (\n -> nameSrcSpan n < span) 
+                                 (reverse $ map idName globals)
+                              --   ^^ assumes md_types is sorted
+              in decl
+
+-- | Find the Module corresponding to a FilePath
+findModuleFromFile :: HscEnv -> FilePath -> Maybe Module
+findModuleFromFile hsc_env fp =
+   listToMaybe $ [ms_mod ms | ms <- hsc_mod_graph hsc_env
+                            , ml_hs_file(ms_location ms) == Just (read fp)]
+
+
 -- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: Session -> String -> SingleStep -> IO RunResult
@@ -227,7 +255,7 @@ traceRunStatus expr ref bindings final_ids
         if b
            then handle_normally
            else do
-             let history' = consBL (History apStack info) history
+             let history' = mkHistory hsc_env apStack info `consBL` history
                 -- probably better make history strict here, otherwise
                 -- our BoundedList will be pointless.
              evaluate history'
@@ -371,10 +399,11 @@ resume (Session ref) step
                                  return tid)
                              (takeMVar statusMVar)
                                       -- and wait for the result 
-                let hist' = case info of 
-                              Nothing -> fromListBL 50 hist
-                              Just i -> History apStack i `consBL` 
-                                                     fromListBL 50 hist
+                let hist' = 
+                     case info of 
+                       Nothing -> fromListBL 50 hist
+                       Just i -> mkHistory hsc_env apStack i `consBL` 
+                                                        fromListBL 50 hist
                 case step of
                   RunAndLogSteps -> 
                         traceRunStatus expr ref bindings final_ids
@@ -425,7 +454,7 @@ moveHist fn (Session ref) = do
                             resumeBreakInfo = mb_info } ->
                           update_ic apStack mb_info
            else case history !! (new_ix - 1) of 
-                   History apStack info ->
+                   History apStack info _ ->
                           update_ic apStack (Just info)
 
 -- -----------------------------------------------------------------------------