Commit e2782137 authored by Simon Marlow's avatar Simon Marlow

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
parent b1f0cd39
......@@ -224,7 +224,6 @@ typecheckIface iface
, md_rules = rules
, md_vect_info = vect_info
, md_exports = exports
, md_modBreaks = emptyModBreaks
}
}
\end{code}
......
......@@ -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
......
......@@ -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
}))
......
......@@ -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
......
......@@ -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}
%************************************************************************
......
......@@ -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
......
......@@ -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
})
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment