From e2782137c799a08711cac0844418cc0345a7ceb5 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 5 Sep 2007 10:47:16 +0000 Subject: [PATCH] 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 --- compiler/iface/TcIface.lhs | 1 - compiler/main/DriverPipeline.hs | 4 ++-- compiler/main/GHC.hs | 2 +- compiler/main/HscMain.lhs | 18 +++++++++--------- compiler/main/HscTypes.lhs | 15 +++++++-------- compiler/main/InteractiveEval.hs | 20 +++++++++++++++----- compiler/main/TidyPgm.lhs | 5 ++--- 7 files changed, 36 insertions(+), 29 deletions(-) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 8dca71e..9345208 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 }) } -- 1.7.10.4