Adjust code from manual merges

diff --git a/compiler/deSugar/DsBreakpoint.lhs b/compiler/deSugar/DsBreakpoint.lhs
index ed7a536..f6c7d9e 100644 (file)
--- 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 (file)
index 0000000..2b78c36
--- /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 04c5ffa..df588aa 100644 (file)
--- 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 b1b0118..ecb3c33 100644 (file)
--- a/compiler/main/Breakpoints.hs
+++ b/compiler/main/Breakpoints.hs
@@ -20,6 +20,7 @@ import PrelNames
 \r
 import GHC.Exts                  ( unsafeCoerce# )\r
 \r
+#ifdef GHCI\r
 data BkptHandler a = BkptHandler {\r
      handleBreakpoint  :: forall b. Session -> [(Id,HValue)] -> BkptLocation a ->  String -> b -> IO b\r
    , isAutoBkptEnabled :: Session -> BkptLocation a -> IO Bool\r
@@ -29,6 +30,7 @@ nullBkptHandler = BkptHandler {
     isAutoBkptEnabled = \ _ _     -> return False,\r
     handleBreakpoint  = \_ _ _ _ b -> putStrLn "null Bkpt Handler" >> return b\r
                               }\r
+#endif\r
 \r
 type BkptLocation a = (a, SiteNumber)\r
 type SiteNumber   = Int\r

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index a176a73..2bd6816 100644 (file)
--- 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 ef9fd02..ad52387 100644 (file)
--- 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 (file)
index 0000000..4f25cee
--- /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 044b67d..156b52f 100644 (file)
--- 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 45f5ff6..f1ec48a 100644 (file)
--- 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
  */