FIX #1650: ".boot modules interact badly with the ghci debugger"

In fact hs-boot files had nothing to do with it: the problem was that
GHCi would forget the breakpoint information for a module that had
been reloaded but not recompiled.  It's amazing that we never noticed
this before.

The ModBreaks were in the ModDetails, which was the wrong place.  When
we avoid recompiling a module, ModDetails is regenerated from ModIface
by typecheckIface, and at that point it has no idea what the ModBreaks
should be, so typecheckIface made it empty.  The right place for the
ModBreaks to go is with the Linkable, which is retained when
compilation is avoided.  So now I've placed the ModBreaks in with the
CompiledByteCode, which also makes it clear that only byte-code
modules have breakpoints.

This fixes break022/break023

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 8dca71e..9345208 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -224,7 +224,6 @@ typecheckIface iface
                              , md_rules     = rules
                               , md_vect_info = vect_info
                              , md_exports   = exports
-                              , md_modBreaks = emptyModBreaks
                              }
     }
 \end{code}

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index e9db1ab..c0ea4fc 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -189,9 +189,9 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
        handleInterpreted (InteractiveNoRecomp, iface, details)
            = ASSERT (isJust maybe_old_linkable)
              return (CompOK details iface maybe_old_linkable)
-       handleInterpreted (InteractiveRecomp hasStub comp_bc, iface, details)
+       handleInterpreted (InteractiveRecomp hasStub comp_bc modBreaks, iface, details)
            = do stub_unlinked <- getStubLinkable hasStub
-                let hs_unlinked = [BCOs comp_bc]
+                let hs_unlinked = [BCOs comp_bc modBreaks]
                     unlinked_time = ms_hs_date mod_summary
                   -- Why do we use the timestamp of the source file here,
                   -- rather than the current time?  This works better in

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index d697bdc..3ce5270 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1877,7 +1877,7 @@ getHomeModuleInfo hsc_env mdl =
                        minf_rdr_env   = mi_globals $! hm_iface hmi,
                        minf_instances = md_insts details
 #ifdef GHCI
-                       ,minf_modBreaks = md_modBreaks details  
+                       ,minf_modBreaks = getModBreaks hmi
 #endif
                        }))
 

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index c4a55bf..72abafb 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -210,6 +210,7 @@ data InteractiveStatus
     = InteractiveNoRecomp
     | InteractiveRecomp Bool     -- Same as HscStatus
                         CompiledByteCode
+                        ModBreaks
 
 
 -- I want Control.Monad.State! --Lemmih 03/07/2006
@@ -246,7 +247,6 @@ liftIO ioA = Comp $ \s -> do a <- ioA
                              return (a,s)
 
 type NoRecomp result = ModIface -> Comp result
-type FrontEnd core = Comp (Maybe core)
 
 -- FIXME: The old interface and module index are only using in 'batch' and
 --        'interactive' mode. They should be removed from 'oneshot' mode.
@@ -262,8 +262,8 @@ type Compiler result =  HscEnv
 -- then combines the FrontEnd and BackEnd to a working compiler.
 hscMkCompiler :: NoRecomp result         -- What to do when recompilation isn't required.
               -> (Maybe (Int,Int) -> Bool -> Comp ())
-              -> FrontEnd core
-              -> (core -> Comp result)   -- Backend.
+              -> Comp (Maybe ModGuts)       -- Front end
+              -> (ModGuts -> Comp result)   -- Backend.
               -> Compiler result
 hscMkCompiler norecomp messenger frontend backend
               hsc_env mod_summary source_unchanged
@@ -402,7 +402,7 @@ batchMsg mb_mod_index recomp
 -- FrontEnds
 --------------------------------------------------------------
 
-hscCoreFrontEnd :: FrontEnd ModGuts
+hscCoreFrontEnd :: Comp (Maybe ModGuts)
 hscCoreFrontEnd =
     do hsc_env <- gets compHscEnv
        mod_summary <- gets compModSummary
@@ -427,7 +427,7 @@ hscCoreFrontEnd =
                      Just mod_guts -> return (Just mod_guts)         -- No desugaring to do!
 
         
-hscFileFrontEnd :: FrontEnd ModGuts
+hscFileFrontEnd :: Comp (Maybe ModGuts)
 hscFileFrontEnd =
     do hsc_env <- gets compHscEnv
        mod_summary <- gets compModSummary
@@ -619,7 +619,8 @@ hscInteractive (iface, details, cgguts)
                      cg_module   = this_mod,
                      cg_binds    = core_binds,
                      cg_tycons   = tycons,
-                     cg_foreign  = foreign_stubs } = cgguts
+                     cg_foreign  = foreign_stubs,
+                     cg_modBreaks = mod_breaks } = cgguts
              dflags = hsc_dflags hsc_env
              location = ms_location mod_summary
              data_tycons = filter isDataTyCon tycons
@@ -632,11 +633,11 @@ hscInteractive (iface, details, cgguts)
          prepd_binds <- {-# SCC "CorePrep" #-}
                         corePrepPgm dflags core_binds data_tycons ;
          -----------------  Generate byte code ------------------
-         comp_bc <- byteCodeGen dflags prepd_binds data_tycons (md_modBreaks details)
+         comp_bc <- byteCodeGen dflags prepd_binds data_tycons mod_breaks
          ------------------ Create f-x-dynamic C-side stuff ---
          (istub_h_exists, istub_c_exists) 
              <- outputForeignStubs dflags this_mod location foreign_stubs
-         return (InteractiveRecomp istub_c_exists comp_bc, iface, details)
+         return (InteractiveRecomp istub_c_exists comp_bc mod_breaks, iface, details)
 #else
     = panic "GHC not compiled with interpreter"
 #endif
@@ -678,7 +679,6 @@ hscFileCheck hsc_env mod_summary compileToCore = do {
                                md_exports   = tcg_exports   tc_result,
                                md_insts     = tcg_insts     tc_result,
                                md_fam_insts = tcg_fam_insts tc_result,
-                                md_modBreaks = emptyModBreaks,      
                                md_rules     = [panic "no rules"],
                                   -- Rules are CoreRules, not the
                                   -- RuleDecls we get out of the typechecker

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 10f00fd..ea8ed64 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -499,7 +499,6 @@ data ModDetails
         md_insts     :: ![Instance],  -- Dfun-ids for the instances in this module
         md_fam_insts :: ![FamInst],
         md_rules     :: ![CoreRule],  -- Domain may include Ids from other modules
-        md_modBreaks :: !ModBreaks,   -- Breakpoint information for this module 
         md_vect_info :: !VectInfo     -- Vectorisation information
      }
 
@@ -508,7 +507,6 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
                               md_insts     = [],
                               md_rules     = [],
                               md_fam_insts = [],
-                               md_modBreaks = emptyModBreaks,
                                md_vect_info = noVectInfo
                              } 
 
@@ -591,7 +589,8 @@ data CgGuts
 
        cg_foreign  :: !ForeignStubs,   
        cg_dep_pkgs :: ![PackageId],    -- Used to generate #includes for C code gen
-        cg_hpc_info :: !HpcInfo         -- info about coverage tick boxes
+        cg_hpc_info :: !HpcInfo,         -- info about coverage tick boxes
+        cg_modBreaks :: !ModBreaks
     }
 
 -----------------------------------
@@ -1386,7 +1385,7 @@ data Unlinked
    = DotO FilePath
    | DotA FilePath
    | DotDLL FilePath
-   | BCOs CompiledByteCode
+   | BCOs CompiledByteCode ModBreaks
 
 #ifndef GHCI
 data CompiledByteCode = NoByteCode
@@ -1397,9 +1396,9 @@ instance Outputable Unlinked where
    ppr (DotA path)   = text "DotA" <+> text path
    ppr (DotDLL path) = text "DotDLL" <+> text path
 #ifdef GHCI
-   ppr (BCOs bcos)   = text "BCOs" <+> ppr bcos
+   ppr (BCOs bcos _)   = text "BCOs" <+> ppr bcos
 #else
-   ppr (BCOs bcos)   = text "No byte code"
+   ppr (BCOs bcos _)   = text "No byte code"
 #endif
 
 isObject (DotO _)   = True
@@ -1414,8 +1413,8 @@ nameOfObject (DotA fn)   = fn
 nameOfObject (DotDLL fn) = fn
 nameOfObject other       = pprPanic "nameOfObject" (ppr other)
 
-byteCodeOfObject (BCOs bc) = bc
-byteCodeOfObject other     = pprPanic "byteCodeOfObject" (ppr other)
+byteCodeOfObject (BCOs bc _) = bc
+byteCodeOfObject other       = pprPanic "byteCodeOfObject" (ppr other)
 \end{code}
 
 %************************************************************************

diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 939c20f..8416a86 100644 (file)
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -21,6 +21,7 @@ module InteractiveEval (
         abandon, abandonAll,
         getResumeContext,
         getHistorySpan,
+        getModBreaks,
         getHistoryModule,
         back, forward,
        setContext, getContext, 
@@ -158,9 +159,17 @@ getHistorySpan hsc_env hist =
    let inf = historyBreakInfo hist
        num = breakInfo_number inf
    in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
-       Just hmi -> modBreaks_locs (md_modBreaks (hm_details hmi)) ! num
+       Just hmi -> modBreaks_locs (getModBreaks hmi) ! num
        _ -> panic "getHistorySpan"
 
+getModBreaks :: HomeModInfo -> ModBreaks
+getModBreaks hmi
+  | Just linkable <- hm_linkable hmi, 
+    [BCOs _ modBreaks] <- linkableUnlinked linkable
+  = modBreaks
+  | otherwise
+  = emptyModBreaks -- probably object code
+
 {- | Finds the enclosing top level function name -}
 -- ToDo: a better way to do this would be to keep hold of the decl_path computed
 -- by the coverage pass, which gives the list of lexically-enclosing bindings
@@ -285,7 +294,7 @@ isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
 isBreakEnabled hsc_env inf =
    case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
        Just hmi -> do
-         w <- getBreak (modBreaks_flags (md_modBreaks (hm_details hmi)))
+         w <- getBreak (modBreaks_flags (getModBreaks hmi))
                        (breakInfo_number inf)
          case w of Just n -> return (n /= 0); _other -> return False
        _ ->
@@ -501,9 +510,10 @@ bindLocalsAtBreakpoint hsc_env apStack Nothing = do
 bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
 
    let 
-       mod_name    = moduleName (breakInfo_module info)
-       mod_details = fmap hm_details (lookupUFM (hsc_HPT hsc_env) mod_name)
-       breaks      = md_modBreaks (expectJust "handlRunStatus" mod_details)
+       mod_name  = moduleName (breakInfo_module info)
+       hmi       = expectJust "bindLocalsAtBreakpoint" $ 
+                        lookupUFM (hsc_HPT hsc_env) mod_name
+       breaks    = getModBreaks hmi
        index     = breakInfo_number info
        vars      = breakInfo_vars info
        result_ty = breakInfo_resty info

diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index c0ca38a..8dabe4e 100644 (file)
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -145,7 +145,6 @@ mkBootModDetails hsc_env (ModGuts { mg_module    = mod
                             , md_fam_insts = fam_insts
                             , md_rules     = []
                             , md_exports   = exports
-                             , md_modBreaks = modBreaks 
                              , md_vect_info = noVectInfo
                              })
        }
@@ -304,14 +303,14 @@ tidyProgram hsc_env
                           cg_dir_imps = dir_imps,
                           cg_foreign  = foreign_stubs,
                           cg_dep_pkgs = dep_pkgs deps,
-                          cg_hpc_info = hpc_info }, 
+                          cg_hpc_info = hpc_info,
+                           cg_modBreaks = modBreaks }, 
 
                   ModDetails { md_types     = tidy_type_env,
                                md_rules     = tidy_rules,
                                md_insts     = tidy_insts,
                                md_fam_insts = fam_insts,
                                md_exports   = exports,
-                                md_modBreaks = modBreaks,
                                 md_vect_info = vect_info    -- is already tidy
                               })
        }