Commit ead42435 authored by mnislaih's avatar mnislaih
Browse files

Extend the GHC API with breakpoints and breakpoint handlers

The entry point is:
setBreakpointHandler :: Session -> BkptHandler Module -> IO ()
parent 2c92736e
-----------------------------------------------------------------------------
--
-- GHC API breakpoints. This module includes the main API (BkptHandler) and
-- utility code for implementing a client to this API used in GHCi
--
-- Pepe Iborra (supported by Google SoC) 2006
--
-----------------------------------------------------------------------------
module Breakpoints where
import {-#SOURCE#-} HscTypes ( Session )
data BkptHandler a = BkptHandler {
handleBreakpoint :: forall b. Session -> [(Id,HValue)] -> BkptLocation a -> String -> b -> IO b
, isAutoBkptEnabled :: Session -> BkptLocation a -> IO Bool
}
nullBkptHandler = BkptHandler {
isAutoBkptEnabled = \ _ _ -> return False,
handleBreakpoint = \_ _ _ _ b -> putStrLn "null Bkpt Handler" >> return b
}
type BkptLocation a = (a, SiteNumber)
type SiteNumber = Int
......@@ -84,6 +84,9 @@ import Util ( split )
import Data.Char ( isDigit, isUpper )
import System.IO ( hPutStrLn, stderr )
import Breakpoints ( BkptHandler )
import Module ( ModuleName )
-- -----------------------------------------------------------------------------
-- DynFlags
......@@ -303,6 +306,9 @@ data DynFlags = DynFlags {
-- message output
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
-- breakpoint handling
,bkptHandler :: Maybe (BkptHandler Module)
}
data HscTarget
......@@ -411,7 +417,8 @@ defaultDynFlags =
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
bkptHandler = Nothing,
flags = [
Opt_ReadUserPackageConf,
......
......@@ -82,6 +82,7 @@ module GHC (
compileExpr, HValue, dynCompileExpr,
lookupName,
getBreakpointHandler, setBreakpointHandler,
obtainTerm,
#endif
......@@ -343,6 +344,12 @@ defaultCleanupHandler dflags inner =
inner
#if defined(GHCI)
GLOBAL_VAR(v_bkptLinkEnv, [], [(Name, HValue)])
-- stores the current breakpoint handler to help setContext to
-- restore it after a context change
#endif
-- | Starts a new session. A session consists of a set of loaded
-- modules, a set of options (DynFlags), and an interactive context.
-- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
......@@ -1924,7 +1931,7 @@ setContext :: Session
-> [Module] -- entire top level scope of these modules
-> [Module] -- exports only of these modules
-> IO ()
setContext (Session ref) toplev_mods export_mods = do
setContext sess@(Session ref) toplev_mods export_mods = do
hsc_env <- readIORef ref
let old_ic = hsc_IC hsc_env
hpt = hsc_HPT hsc_env
......@@ -1935,7 +1942,7 @@ setContext (Session ref) toplev_mods export_mods = do
writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
ic_exports = export_mods,
ic_rn_gbl_env = all_env }}
reinstallBreakpointHandlers sess
-- Make a GlobalRdrEnv based on the exports of the modules only.
mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
......@@ -2194,6 +2201,73 @@ showModule s mod_summary = withSession s $ \hsc_env -> do
where
obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
getBreakpointHandler :: Session -> IO (Maybe (BkptHandler Module))
getBreakpointHandler session = getSessionDynFlags session >>= return . bkptHandler
setBreakpointHandler :: Session -> BkptHandler Module -> IO ()
setBreakpointHandler session handler = do
dflags <- getSessionDynFlags session
setSessionDynFlags session dflags{ bkptHandler = Just handler }
let linkEnv = [ ( breakpointJumpName
, unsafeCoerce# (jumpFunction session handler))
, ( breakpointCondJumpName
, unsafeCoerce# (jumpCondFunction session handler))
, ( breakpointAutoJumpName
, unsafeCoerce# (jumpAutoFunction session handler))
]
writeIORef v_bkptLinkEnv linkEnv
dflags <- getSessionDynFlags session
reinstallBreakpointHandlers session
reinstallBreakpointHandlers :: Session -> IO ()
reinstallBreakpointHandlers session = do
dflags <- getSessionDynFlags session
let mode = ghcMode dflags
when (mode == Interactive) $ do
linkEnv <- readIORef v_bkptLinkEnv
initDynLinker dflags
extendLinkEnv linkEnv
type SiteInfo = (String, String, SiteNumber)
jumpFunction, jumpAutoFunction :: Session -> BkptHandler Module -> Int -> [Opaque]
-> SiteInfo -> String -> b -> b
jumpCondFunction :: Session -> BkptHandler Module -> Int -> [Opaque]
-> SiteInfo -> String -> Bool -> b -> b
jumpFunctionM :: Session -> BkptHandler a -> Int -> [Opaque] -> BkptLocation a
-> String -> b -> IO b
jumpCondFunction _ _ _ _ _ _ False b = b
jumpCondFunction session handler ptr hValues siteInfo locmsg True b
= jumpFunction session handler ptr hValues siteInfo locmsg b
jumpFunction session handler ptr hValues siteInfo locmsg b
| site <- mkSite siteInfo
= unsafePerformIO $ jumpFunctionM session handler ptr hValues site 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]
handleBreakpoint handler session (zip ids hValues) site locmsg b
jumpAutoFunction session handler ptr hValues siteInfo locmsg b
| site <- mkSite siteInfo
= unsafePerformIO $ do
break <- isAutoBkptEnabled handler session site
if break
then jumpFunctionM session handler ptr hValues site locmsg b
else return b
jumpStepByStepFunction session handler ptr hValues siteInfo locmsg b
| site <- mkSite siteInfo
= unsafePerformIO $ do
jumpFunctionM session handler ptr hValues site locmsg b
mkSite :: SiteInfo -> BkptLocation Module
mkSite (pkgName, modName, sitenum) =
(mkModule (stringToPackageId pkgName) (mkModuleName modName), sitenum)
obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
obtainTerm sess force id = withSession sess $ \hsc_env ->
getHValue (varName id) >>= traverse (cvObtainTerm hsc_env force Nothing)
......
> module HscTypes where
>
> data Session
\ No newline at end of file
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