projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Make -fext-core a dynamic flag (it was a static flag)
[ghc-hetmet.git]
/
compiler
/
main
/
InteractiveEval.hs
diff --git
a/compiler/main/InteractiveEval.hs
b/compiler/main/InteractiveEval.hs
index
36e6f7c
..
44972d5
100644
(file)
--- a/
compiler/main/InteractiveEval.hs
+++ b/
compiler/main/InteractiveEval.hs
@@
-308,7
+308,7
@@
traceRunStatus expr bindings final_ids
let history' = mkHistory hsc_env apStack info `consBL` history
-- probably better make history strict here, otherwise
-- our BoundedList will be pointless.
let history' = mkHistory hsc_env apStack info `consBL` history
-- probably better make history strict here, otherwise
-- our BoundedList will be pointless.
- liftIO $ evaluate history'
+ _ <- liftIO $ evaluate history'
status <-
withBreakAction True (hsc_dflags hsc_env)
breakMVar statusMVar $ do
status <-
withBreakAction True (hsc_dflags hsc_env)
breakMVar statusMVar $ do
@@
-431,8
+431,8
@@
noBreakAction :: Bool -> BreakInfo -> HValue -> IO ()
noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
noBreakAction True _ _ = return () -- exception: just continue
noBreakAction False _ _ = putStrLn "*** Ignoring breakpoint"
noBreakAction True _ _ = return () -- exception: just continue
-resume :: GhcMonad m => SingleStep -> m RunResult
-resume step
+resume :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m RunResult
+resume canLogSpan step
= do
hsc_env <- getSession
let ic = hsc_IC hsc_env
= do
hsc_env <- getSession
let ic = hsc_IC hsc_env
@@
-459,7
+459,7
@@
resume step
when (isStep step) $ liftIO setStepFlag
case r of
Resume expr tid breakMVar statusMVar bindings
when (isStep step) $ liftIO setStepFlag
case r of
Resume expr tid breakMVar statusMVar bindings
- final_ids apStack info _ hist _ -> do
+ final_ids apStack info span hist _ -> do
withVirtualCWD $ do
withBreakAction (isStep step) (hsc_dflags hsc_env)
breakMVar statusMVar $ do
withVirtualCWD $ do
withBreakAction (isStep step) (hsc_dflags hsc_env)
breakMVar statusMVar $ do
@@
-468,10
+468,12
@@
resume step
-- this awakens the stopped thread...
takeMVar statusMVar
-- and wait for the result
-- this awakens the stopped thread...
takeMVar statusMVar
-- and wait for the result
- let hist' =
- case info of
- Nothing -> fromListBL 50 hist
- Just i -> mkHistory hsc_env apStack i `consBL`
+ let prevHistoryLst = fromListBL 50 hist
+ hist' = case info of
+ Nothing -> prevHistoryLst
+ Just i
+ | not $canLogSpan span -> prevHistoryLst
+ | otherwise -> mkHistory hsc_env apStack i `consBL`
fromListBL 50 hist
case step of
RunAndLogSteps ->
fromListBL 50 hist
case step of
RunAndLogSteps ->
@@
-607,18
+609,22
@@
bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
-- - tidy the type variables
-- - globalise the Id (Ids are supposed to be Global, apparently).
--
-- - tidy the type variables
-- - globalise the Id (Ids are supposed to be Global, apparently).
--
- let all_ids | isPointer result_id = result_id : new_ids
- | otherwise = new_ids
+ let result_ok = isPointer result_id
+ && not (isUnboxedTupleType (idType result_id))
+
+ all_ids | result_ok = result_id : new_ids
+ | otherwise = new_ids
(id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
(_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
new_tyvars = unionVarSets tyvarss
(id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
(_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
new_tyvars = unionVarSets tyvarss
- let final_ids = zipWith setIdType all_ids tidy_tys
+ final_ids = zipWith setIdType all_ids tidy_tys
ictxt0 = hsc_IC hsc_env
ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
ictxt0 = hsc_IC hsc_env
ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
+
Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
- Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
+ when result_ok $ Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
- return (hsc_env1, result_name:names, span)
+ return (hsc_env1, if result_ok then result_name:names else names, span)
where
mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do
where
mkNewId :: OccName -> Id -> IO Id
mkNewId occ id = do