Commit e81584fd authored by mnislaih's avatar mnislaih
Browse files

Extend the local bindings at a breakpoint with one for the wrapped expression

By popular request, in a breakpoint it is possible now to inspect the result of the expression wrapped by the breakpoint.

The user interface for this is right now preliminar; there is a new binding called '_result' at every breakpoint. Suggestions are welcome!
parent 91388bb3
......@@ -47,15 +47,17 @@ import Data.IORef
import Foreign.StablePtr
import GHC.Exts
#ifdef GHCI
mkBreakpointExpr :: SrcSpan -> Id -> DsM (LHsExpr Id)
mkBreakpointExpr loc bkptFuncId = do
mkBreakpointExpr :: SrcSpan -> Id -> Type -> DsM (LHsExpr Id)
mkBreakpointExpr loc bkptFuncId ty = do
scope <- getScope
mod <- getModuleDs
u <- newUnique
let mod_name = moduleNameFS$ moduleName mod
valId = mkUserLocal (mkVarOcc "_result") u ty noSrcLoc
when (not instrumenting) $
warnDs (text "Extracted ids:" <+> (ppr scope $$
ppr (map idType scope)))
stablePtr <- ioToIOEnv $ newStablePtr scope
stablePtr <- ioToIOEnv $ newStablePtr (valId:scope)
site <- if instrumenting
then recordBkpt (srcSpanStart loc)
else return 0
......
......@@ -192,12 +192,16 @@ dsLExpr :: LHsExpr Id -> DsM CoreExpr
#if defined(GHCI)
dsLExpr (L loc expr@(HsWrap w (HsVar v)))
| idName v `elem` [breakpointName, breakpointCondName, breakpointAutoName]
, WpTyApp ty <- simpWrapper w
= do areBreakpointsEnabled <- breakpoints_enabled
if areBreakpointsEnabled
then do
L _ breakpointExpr <- mkBreakpointExpr loc v
L _ breakpointExpr <- mkBreakpointExpr loc v ty
dsLExpr (L loc $ HsWrap w breakpointExpr)
else putSrcSpanDs loc $ dsExpr expr
where simpWrapper (WpCompose w1 WpHole) = w1
simpWrapper (WpCompose WpHole w1) = w1
simpWrapper w = w
#endif
dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
......
......@@ -2208,6 +2208,7 @@ foreign import "rts_evalStableIO" {- safe -}
-- more informative than the C type!
-}
-----------------------------------------------------------------------------
-- show a module and it's source/object filenames
......@@ -2224,6 +2225,9 @@ isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
where
obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
-----------------------------------------------------------------------------
-- Breakpoint handlers
getBreakpointHandler :: Session -> IO (Maybe (BkptHandler Module))
getBreakpointHandler session = getSessionDynFlags session >>= return . bkptHandler
......@@ -2251,6 +2255,9 @@ reinstallBreakpointHandlers session = do
initDynLinker dflags
extendLinkEnv linkEnv
-----------------------------------------------------------------------
-- Jump functions
type SiteInfo = (String, String, SiteNumber)
jumpFunction, jumpAutoFunction :: Session -> BkptHandler Module -> Int -> [Opaque]
-> SiteInfo -> String -> b -> b
......@@ -2270,8 +2277,7 @@ jumpFunction session handler ptr hValues siteInfo locmsg b
jumpFunctionM session handler (I# idsPtr) wrapped_hValues site locmsg b =
do
ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
ASSERT (length ids == length wrapped_hValues) return ()
let hValues = [unsafeCoerce# hv | O hv <- wrapped_hValues]
let hValues = unsafeCoerce# b : [unsafeCoerce# hv | O hv <- wrapped_hValues]
handleBreakpoint handler session (zip ids hValues) site locmsg b
jumpAutoFunction session handler ptr hValues siteInfo locmsg b
......
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