X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=3530d78c41b0d0fa44642a22655cbae3e854e825;hb=0ed635befe3cefab52d60ed06fc36668a9795e52;hp=1859582505dbcb21de116c6e12ace5ee53d081aa;hpb=7bf92baeaa558bab450bcda6e65649be082fd1a7;p=ghc-hetmet.git

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 1859582..3530d78 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -13,7 +13,10 @@ module InteractiveEval (
         resume,
         abandon, abandonAll,
         getResumeContext,
+        getHistoryTick,
         getHistorySpan,
+        getHistoryModule,
+        findEnclosingDeclSpanByTick,
         back, forward,
 	setContext, getContext,	
         nameSetToGlobalRdrEnv,
@@ -69,6 +72,7 @@ import BasicTypes
 import Outputable
 
 import Data.Dynamic
+import Data.List (find)
 import Control.Monad
 import Foreign
 import Foreign.C
@@ -128,17 +132,61 @@ isStep _ = True
 data History
    = History {
         historyApStack   :: HValue,
-        historyBreakInfo :: BreakInfo
+        historyBreakInfo :: BreakInfo,
+        historyEnclosingDecl :: Name
+         -- ^^ A cache of the enclosing top level declaration, for convenience
    }
 
-getHistorySpan :: Session -> History -> IO SrcSpan
-getHistorySpan s hist = withSession s $ \hsc_env -> do
-   let inf = historyBreakInfo hist 
+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
+
+getHistoryTick :: History -> BreakIndex
+getHistoryTick = breakInfo_number . historyBreakInfo 
+
+getHistoryModule :: History -> Module
+getHistoryModule = breakInfo_module . historyBreakInfo
+
+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"
 
+-- | Finds the enclosing top level function name 
+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
+
+-- | Finds the span of the (smallest) function containing this BreakIndex
+findEnclosingDeclSpanByTick :: HscEnv -> Module -> BreakIndex -> SrcSpan
+findEnclosingDeclSpanByTick hsc_env mod tick = 
+   case lookupUFM (hsc_HPT hsc_env) (moduleName mod) of
+         Nothing -> panic "findEnclosingDecl"
+         Just hmi -> let
+             modbreaks = md_modBreaks (hm_details hmi)
+          in ASSERT (inRange (bounds (modBreaks_decls modbreaks)) tick)
+             modBreaks_decls modbreaks ! tick
+
+-- | 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
@@ -223,7 +271,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'
@@ -367,10 +415,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
@@ -421,7 +470,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)
 
 -- -----------------------------------------------------------------------------