Commit 989cfb23 authored by mnislaih's avatar mnislaih

Adjust code from manual merges

parent 8d5364c1
......@@ -54,7 +54,6 @@ import Data.IORef
import Foreign.StablePtr ( newStablePtr, castStablePtrToPtr )
import GHC.Exts ( Ptr(..), Int(..), addr2Int#, unsafeCoerce# )
#if defined(GHCI)
mkBreakpointExpr :: SrcSpan -> Id -> DsM (LHsExpr Id)
mkBreakpointExpr loc bkptFuncId = do
scope' <- getLocalBindsDs
......@@ -110,36 +109,8 @@ debug_enabled = do
b_enabled <- breakpoints_enabled
return (debugging && b_enabled)
breakpoints_enabled :: DsM Bool
breakpoints_enabled = do
ghcMode <- getGhcModeDs
currentModule <- getModuleDs
ignore_breakpoints <- doptDs Opt_IgnoreBreakpoints
return ( not ignore_breakpoints
&& ghcMode == Interactive
&& currentModule /= iNTERACTIVE )
maybeInsertBreakpoint :: LHsExpr Id -> Type -> DsM (LHsExpr Id)
--maybeInsertBreakpoint e | pprTrace("insertBreakpoint at" (ppr e) False = undefined
maybeInsertBreakpoint lhsexpr@(L loc _) ty = do
instrumenting <- isInstrumentationSpot lhsexpr
if instrumenting
then do L _ dynBkpt <- dynBreakpoint loc
-- return (l (HsApp (l$ TyApp dynBkpt [ty]) lhsexpr))
return$ l(HsApp (l$ HsWrap (WpTyApp ty) dynBkpt) lhsexpr)
else return lhsexpr
where l = L loc
dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr
dsAndThenMaybeInsertBreakpoint expr@(L loc _) = do
coreExpr <- dsLExpr expr
instrumenting <- isInstrumentationSpot expr
if instrumenting
then do L _ dynBkpt<- dynBreakpoint loc
bkptCore <- dsLExpr (l$ HsWrap (WpTyApp (exprType coreExpr)) dynBkpt)
return (bkptCore `App` coreExpr)
else return coreExpr
where l = L loc
isInstrumentationSpot (L loc e) = do
ghcmode <- getGhcModeDs
......@@ -202,9 +173,39 @@ mkJumpFunc bkptFuncId
(basicType extra (mkTyConApp opaqueTyCon [])) vanillaIdInfo
mkTupleType tys = mkTupleTy Boxed (length tys) tys
breakpoints_enabled :: DsM Bool
dsAndThenMaybeInsertBreakpoint :: LHsExpr Id -> DsM CoreExpr
#ifdef GHCI
maybeInsertBreakpoint lhsexpr@(L loc _) ty = do
instrumenting <- isInstrumentationSpot lhsexpr
if instrumenting
then do L _ dynBkpt <- dynBreakpoint loc
-- return (l (HsApp (l$ TyApp dynBkpt [ty]) lhsexpr))
return$ l(HsApp (l$ HsWrap (WpTyApp ty) dynBkpt) lhsexpr)
else return lhsexpr
where l = L loc
dsAndThenMaybeInsertBreakpoint expr@(L loc _) = do
coreExpr <- dsLExpr expr
instrumenting <- isInstrumentationSpot expr
if instrumenting
then do L _ dynBkpt<- dynBreakpoint loc
bkptCore <- dsLExpr (l$ HsWrap (WpTyApp (exprType coreExpr)) dynBkpt)
return (bkptCore `App` coreExpr)
else return coreExpr
where l = L loc
breakpoints_enabled = do
ghcMode <- getGhcModeDs
currentModule <- getModuleDs
ignore_breakpoints <- doptDs Opt_IgnoreBreakpoints
return ( not ignore_breakpoints
&& ghcMode == Interactive
&& currentModule /= iNTERACTIVE )
#else
maybeInsertBreakpoint expr _ = return expr
dsAndThenMaybeInsertBreakpoint coreExpr = dsLExpr coreExpr
breakpoints_enabled = False
breakpoints_enabled = return False
#endif
\end{code}
>module ByteCodeLink where
>
>data HValue
......@@ -140,13 +140,14 @@ handler :: Exception -> GHCi Bool
handler (DynException dyn)
| Just StopChildSession <- fromDynamic dyn
-- propagate to the parent session
= ASSERTM (liftM not isTopLevel) >> throwDyn StopChildSession
= do ASSERTM (liftM not isTopLevel)
throwDyn StopChildSession
| Just (ChildSessionStopped msg) <- fromDynamic dyn
-- Revert CAFs and display some message
= ASSERTM (isTopLevel) >>
io (revertCAFs >> putStrLn msg) >>
return False
= do ASSERTM (isTopLevel)
io (revertCAFs >> putStrLn msg)
return False
handler exception = do
flushInterpBuffers
......@@ -231,7 +232,7 @@ no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
" Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
flush_cmd = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush System.IO.stderr"
initInterpBuffering :: Session -> IO ()
initInterpBuffering :: GHC.Session -> IO ()
initInterpBuffering session
= do maybe_hval <- GHC.compileExpr session no_buf_cmd
......
......@@ -20,6 +20,7 @@ import PrelNames
import GHC.Exts ( unsafeCoerce# )
#ifdef GHCI
data BkptHandler a = BkptHandler {
handleBreakpoint :: forall b. Session -> [(Id,HValue)] -> BkptLocation a -> String -> b -> IO b
, isAutoBkptEnabled :: Session -> BkptLocation a -> IO Bool
......@@ -29,6 +30,7 @@ nullBkptHandler = BkptHandler {
isAutoBkptEnabled = \ _ _ -> return False,
handleBreakpoint = \_ _ _ _ b -> putStrLn "null Bkpt Handler" >> return b
}
#endif
type BkptLocation a = (a, SiteNumber)
type SiteNumber = Int
......
......@@ -84,9 +84,10 @@ import Util ( split )
import Data.Char ( isDigit, isUpper )
import System.IO ( hPutStrLn, stderr )
#ifdef GHCI
import Breakpoints ( BkptHandler )
import Module ( ModuleName )
#endif
-- -----------------------------------------------------------------------------
-- DynFlags
......@@ -308,8 +309,10 @@ data DynFlags = DynFlags {
-- message output
log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
#ifdef GHCI
-- breakpoint handling
,bkptHandler :: Maybe (BkptHandler Module)
#endif
}
data HscTarget
......@@ -418,8 +421,9 @@ defaultDynFlags =
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
#ifdef GHCI
bkptHandler = Nothing,
#endif
flags = [
Opt_ReadUserPackageConf,
......
......@@ -180,6 +180,7 @@ module GHC (
#include "HsVersions.h"
#ifdef GHCI
import RtClosureInspect ( cvObtainTerm, Term )
import TcRnDriver ( tcRnLookupRdrName, tcRnGetInfo,
tcRnLookupName, getModuleExports )
import RdrName ( plusGlobalRdrEnv, Provenance(..),
......@@ -206,7 +207,6 @@ import Data.Maybe ( fromMaybe)
import qualified Linker
import Data.Dynamic ( Dynamic )
import RtClosureInspect ( cvObtainTerm, Term )
import Linker ( HValue, getHValue, extendLinkEnv )
#endif
......@@ -1763,9 +1763,9 @@ data ModuleInfo = ModuleInfo {
minf_type_env :: TypeEnv,
minf_exports :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
minf_instances :: [Instance],
minf_instances :: [Instance]
#ifdef GHCI
minf_dbg_sites :: [(SiteNumber,Coord)]
,minf_dbg_sites :: [(SiteNumber,Coord)]
#endif
-- ToDo: this should really contain the ModIface too
}
......
>module TcEnv where
>import TcRnTypes
>
>tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
\ No newline at end of file
......@@ -69,8 +69,8 @@ import NameSet
import TyCon
import SrcLoc
import HscTypes
import DsBreakpoint
import Outputable
import Breakpoints
#ifdef GHCI
import Linker
......
......@@ -817,6 +817,7 @@ static RtsSymbolVal rtsSyms[] = {
/* -----------------------------------------------------------------------------
* Insert symbols into hash tables, checking for duplicates.
*/
int isSuffixOf(char* x, char* suffix);
static void ghciInsertStrHashTable ( char* obj_name,
HashTable *table,
......@@ -856,17 +857,6 @@ static void ghciInsertStrHashTable ( char* obj_name,
);
exit(1);
}
#if defined(GHCI) && defined(BREAKPOINT)
static void ghciInsertDCTable ( char* obj_name,
StgWord key,
char* data
)
{
ghciInsertStrHashTable(obj_name, dchash, (char *)key, data);
}
#endif
/* -----------------------------------------------------------------------------
* initialize the object linker
*/
......
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