summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPepe Iborra <mnislaih@gmail.com>2006-12-11 16:20:27 +0000
committerPepe Iborra <mnislaih@gmail.com>2006-12-11 16:20:27 +0000
commit989cfb23660ecefe7e414a1ca1f3004e820ef50b (patch)
tree5ba20daca4df60c6533c8115885c5864e692e4ee
parent8d5364c135b7d40ae62c63ff9e65c684a1712694 (diff)
downloadhaskell-989cfb23660ecefe7e414a1ca1f3004e820ef50b.tar.gz
Adjust code from manual merges
-rw-r--r--compiler/deSugar/DsBreakpoint.lhs61
-rw-r--r--compiler/ghci/ByteCodeLink.lhs-boot3
-rw-r--r--compiler/ghci/GhciMonad.hs11
-rw-r--r--compiler/main/Breakpoints.hs2
-rw-r--r--compiler/main/DynFlags.hs8
-rw-r--r--compiler/main/GHC.hs6
-rw-r--r--compiler/typecheck/TcEnv.lhs-boot4
-rw-r--r--compiler/typecheck/TcRnDriver.lhs2
-rw-r--r--rts/Linker.c12
9 files changed, 57 insertions, 52 deletions
diff --git a/compiler/deSugar/DsBreakpoint.lhs b/compiler/deSugar/DsBreakpoint.lhs
index ed7a53680e..f6c7d9e28b 100644
--- a/compiler/deSugar/DsBreakpoint.lhs
+++ b/compiler/deSugar/DsBreakpoint.lhs
@@ -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}
diff --git a/compiler/ghci/ByteCodeLink.lhs-boot b/compiler/ghci/ByteCodeLink.lhs-boot
new file mode 100644
index 0000000000..2b78c36293
--- /dev/null
+++ b/compiler/ghci/ByteCodeLink.lhs-boot
@@ -0,0 +1,3 @@
+>module ByteCodeLink where
+>
+>data HValue
diff --git a/compiler/ghci/GhciMonad.hs b/compiler/ghci/GhciMonad.hs
index 04c5ffa736..df588aab0a 100644
--- a/compiler/ghci/GhciMonad.hs
+++ b/compiler/ghci/GhciMonad.hs
@@ -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
diff --git a/compiler/main/Breakpoints.hs b/compiler/main/Breakpoints.hs
index b1b0118179..ecb3c3317b 100644
--- a/compiler/main/Breakpoints.hs
+++ b/compiler/main/Breakpoints.hs
@@ -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
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a176a7345e..2bd6816424 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -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,
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index ef9fd02c2c..ad52387556 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -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
}
diff --git a/compiler/typecheck/TcEnv.lhs-boot b/compiler/typecheck/TcEnv.lhs-boot
new file mode 100644
index 0000000000..4f25cee59c
--- /dev/null
+++ b/compiler/typecheck/TcEnv.lhs-boot
@@ -0,0 +1,4 @@
+>module TcEnv where
+>import TcRnTypes
+>
+>tcExtendIdEnv :: [TcId] -> TcM a -> TcM a \ No newline at end of file
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 044b67d6ab..156b52fbef 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -69,8 +69,8 @@ import NameSet
import TyCon
import SrcLoc
import HscTypes
-import DsBreakpoint
import Outputable
+import Breakpoints
#ifdef GHCI
import Linker
diff --git a/rts/Linker.c b/rts/Linker.c
index 45f5ff678c..f1ec48aef8 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -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
*/