abandon, abandonAll,
getResumeContext,
getHistorySpan,
+ getModBreaks,
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
- 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
withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
let thing_to_run = unsafeCoerce# hval :: IO [HValue]
- status <- sandboxIO statusMVar thing_to_run
+ status <- sandboxIO dflags' statusMVar thing_to_run
let ic = hsc_IC hsc_env
bindings = (ic_tmp_ids ic, ic_tyvars ic)
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
_ ->
-- thread. ToDo: we might want a way to continue even if the target
-- thread doesn't die when it receives the exception... "this thread
-- is not responding".
-sandboxIO :: MVar Status -> IO [HValue] -> IO Status
-sandboxIO statusMVar thing =
+sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status
+sandboxIO dflags statusMVar thing =
withInterruptsSentTo
- (forkIO (do res <- Exception.try (rethrow thing)
+ (forkIO (do res <- Exception.try (rethrow dflags thing)
putMVar statusMVar (Complete res)))
(takeMVar statusMVar)
-- to :continue twice, which looks strange). So if the exception is
-- not "Interrupted", we unset the exception flag before throwing.
--
-rethrow :: IO a -> IO a
-rethrow io = Exception.catch io $ \e -> -- NB. not catchDyn
+rethrow :: DynFlags -> IO a -> IO a
+rethrow dflags io = Exception.catch io $ \e -> do -- NB. not catchDyn
case e of
+ -- If -fbreak-on-error, we break unconditionally,
+ -- but with care of not breaking twice
+ _ | dopt Opt_BreakOnError dflags &&
+ not(dopt Opt_BreakOnException dflags)
+ -> poke exceptionFlag 1
+
+ -- If it is an "Interrupted" exception, we allow
+ -- a possible break by way of -fbreak-on-exception
DynException d | Just Interrupted <- fromDynamic d
- -> Exception.throwIO e
- _ -> do poke exceptionFlag 0; Exception.throwIO e
+ -> return ()
+
+ -- In any other case, we don't want to break
+ _ -> poke exceptionFlag 0
+
+ Exception.throwIO e
withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
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
, not $ null [v | v <- varSetElems$ tyVarsOfType (idType id)
, isSkolemTyVar v]
, (occNameFS.nameOccName.idName) id /= result_fs]
- tys <- reconstructType hsc_env False `mapM` incompletelyTypedIds
+ tys <- reconstructType hsc_env 10 `mapM` incompletelyTypedIds
-- map termType `fmap` (obtainTerm hsc_env False `mapM` incompletelyTypedIds)
let substs = [computeRTTIsubst ty ty'
cvObtainTerm hsc_env maxBound force (Just$ idType id) hv
-- Uses RTTI to reconstruct the type of an Id, making it less polymorphic
-reconstructType :: HscEnv -> Bool -> Id -> IO (Maybe Type)
-reconstructType hsc_env force id = do
+reconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)
+reconstructType hsc_env bound id = do
hv <- Linker.getHValue hsc_env (varName id)
- cvReconstructType hsc_env force (Just$ idType id) hv
+ cvReconstructType hsc_env bound (Just$ idType id) hv
#endif /* GHCI */