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
, md_rules = rules
, md_vect_info = vect_info
, md_exports = exports
, md_rules = rules
, md_vect_info = vect_info
, md_exports = exports
- , md_modBreaks = emptyModBreaks
handleInterpreted (InteractiveNoRecomp, iface, details)
= ASSERT (isJust maybe_old_linkable)
return (CompOK details iface maybe_old_linkable)
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
= 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
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
minf_rdr_env = mi_globals $! hm_iface hmi,
minf_instances = md_insts details
#ifdef GHCI
minf_rdr_env = mi_globals $! hm_iface hmi,
minf_instances = md_insts details
#ifdef GHCI
- ,minf_modBreaks = md_modBreaks details
+ ,minf_modBreaks = getModBreaks hmi
= InteractiveNoRecomp
| InteractiveRecomp Bool -- Same as HscStatus
CompiledByteCode
= InteractiveNoRecomp
| InteractiveRecomp Bool -- Same as HscStatus
CompiledByteCode
-- I want Control.Monad.State! --Lemmih 03/07/2006
-- I want Control.Monad.State! --Lemmih 03/07/2006
return (a,s)
type NoRecomp result = ModIface -> Comp result
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.
-- FIXME: The old interface and module index are only using in 'batch' and
-- 'interactive' mode. They should be removed from 'oneshot' mode.
-- 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 ())
-- 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
-> Compiler result
hscMkCompiler norecomp messenger frontend backend
hsc_env mod_summary source_unchanged
-- FrontEnds
--------------------------------------------------------------
-- FrontEnds
--------------------------------------------------------------
-hscCoreFrontEnd :: FrontEnd ModGuts
+hscCoreFrontEnd :: Comp (Maybe ModGuts)
hscCoreFrontEnd =
do hsc_env <- gets compHscEnv
mod_summary <- gets compModSummary
hscCoreFrontEnd =
do hsc_env <- gets compHscEnv
mod_summary <- gets compModSummary
Just mod_guts -> return (Just mod_guts) -- No desugaring to do!
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
hscFileFrontEnd =
do hsc_env <- gets compHscEnv
mod_summary <- gets compModSummary
cg_module = this_mod,
cg_binds = core_binds,
cg_tycons = tycons,
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
dflags = hsc_dflags hsc_env
location = ms_location mod_summary
data_tycons = filter isDataTyCon tycons
prepd_binds <- {-# SCC "CorePrep" #-}
corePrepPgm dflags core_binds data_tycons ;
----------------- Generate byte code ------------------
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
------------------ 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
#else
= panic "GHC not compiled with interpreter"
#endif
md_exports = tcg_exports tc_result,
md_insts = tcg_insts tc_result,
md_fam_insts = tcg_fam_insts tc_result,
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
md_rules = [panic "no rules"],
-- Rules are CoreRules, not the
-- RuleDecls we get out of the typechecker
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_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
}
md_vect_info :: !VectInfo -- Vectorisation information
}
md_insts = [],
md_rules = [],
md_fam_insts = [],
md_insts = [],
md_rules = [],
md_fam_insts = [],
- md_modBreaks = emptyModBreaks,
md_vect_info = noVectInfo
}
md_vect_info = noVectInfo
}
cg_foreign :: !ForeignStubs,
cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen
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
}
-----------------------------------
}
-----------------------------------
= DotO FilePath
| DotA FilePath
| DotDLL FilePath
= DotO FilePath
| DotA FilePath
| DotDLL FilePath
- | BCOs CompiledByteCode
+ | BCOs CompiledByteCode ModBreaks
#ifndef GHCI
data CompiledByteCode = NoByteCode
#ifndef GHCI
data CompiledByteCode = NoByteCode
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
#ifdef GHCI
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
- ppr (BCOs bcos) = text "No byte code"
+ ppr (BCOs bcos _) = text "No byte code"
#endif
isObject (DotO _) = True
#endif
isObject (DotO _) = True
nameOfObject (DotDLL fn) = fn
nameOfObject other = pprPanic "nameOfObject" (ppr other)
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}
%************************************************************************
\end{code}
%************************************************************************
abandon, abandonAll,
getResumeContext,
getHistorySpan,
abandon, abandonAll,
getResumeContext,
getHistorySpan,
getHistoryModule,
back, forward,
setContext, getContext,
getHistoryModule,
back, forward,
setContext, getContext,
let inf = historyBreakInfo hist
num = breakInfo_number inf
in case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
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"
_ -> 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
{- | 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
isBreakEnabled hsc_env inf =
case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
Just hmi -> do
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
_ ->
(breakInfo_number inf)
case w of Just n -> return (n /= 0); _other -> return False
_ ->
bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
let
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
index = breakInfo_number info
vars = breakInfo_vars info
result_ty = breakInfo_resty info
, md_fam_insts = fam_insts
, md_rules = []
, md_exports = exports
, md_fam_insts = fam_insts
, md_rules = []
, md_exports = exports
- , md_modBreaks = modBreaks
, md_vect_info = noVectInfo
})
}
, md_vect_info = noVectInfo
})
}
cg_dir_imps = dir_imps,
cg_foreign = foreign_stubs,
cg_dep_pkgs = dep_pkgs deps,
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,
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
})
}
md_vect_info = vect_info -- is already tidy
})
}