Re-working of the breakpoint support
[ghc-hetmet.git] / compiler / main / GHC.hs
index c786cbb..5f78c3e 100644 (file)
@@ -14,7 +14,8 @@ module GHC (
        newSession,
 
        -- * Flags and settings
-       DynFlags(..), DynFlag(..), Severity(..), GhcMode(..), HscTarget(..), dopt,
+       DynFlags(..), DynFlag(..), Severity(..), HscTarget(..), dopt,
+        GhcMode(..), GhcLink(..),
        parseDynamicFlags,
        getSessionDynFlags,
        setSessionDynFlags,
@@ -79,8 +80,11 @@ module GHC (
        RunResult(..),
        runStmt,
        showModule,
+        isModuleInterpreted,
        compileExpr, HValue, dynCompileExpr,
        lookupName,
+        obtainTerm, obtainTerm1,
+        modInfoModBreaks, 
 #endif
 
        -- * Abstract syntax elements
@@ -136,7 +140,8 @@ module GHC (
        instanceDFunId, pprInstance, pprInstanceHdr,
 
        -- ** Types and Kinds
-       Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
+       Type, dropForAlls, splitForAllTys, funResultTy, 
+       pprParendType, pprTypeApp,
        Kind,
        PredType,
        ThetaType, pprThetaArrow,
@@ -174,9 +179,7 @@ module GHC (
 #include "HsVersions.h"
 
 #ifdef GHCI
-import qualified Linker
-import Data.Dynamic     ( Dynamic )
-import Linker          ( HValue, extendLinkEnv )
+import RtClosureInspect ( cvObtainTerm, Term )
 import TcRnDriver      ( tcRnLookupRdrName, tcRnGetInfo,
                          tcRnLookupName, getModuleExports )
 import RdrName         ( plusGlobalRdrEnv, Provenance(..), 
@@ -185,8 +188,18 @@ import RdrName             ( plusGlobalRdrEnv, Provenance(..),
 import HscMain         ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
 import Name            ( nameOccName )
 import Type            ( tidyType )
+import Var             ( varName )
 import VarEnv          ( emptyTidyEnv )
-import GHC.Exts                ( unsafeCoerce# )
+import GHC.Exts         ( unsafeCoerce#, Ptr )
+import Foreign.StablePtr( deRefStablePtr, castPtrToStablePtr, StablePtr, newStablePtr, freeStablePtr )
+import Foreign          ( poke )
+import Data.Maybe       ( fromMaybe)
+import qualified Linker
+
+import Data.Dynamic     ( Dynamic )
+import Linker          ( HValue, getHValue, extendLinkEnv )
+
+import ByteCodeInstr    (BreakInfo)
 #endif
 
 import Packages                ( initPackages )
@@ -197,7 +210,7 @@ import RdrName              ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
 import HsSyn 
 import Type            ( Kind, Type, dropForAlls, PredType, ThetaType,
                          pprThetaArrow, pprParendType, splitForAllTys,
-                         funResultTy )
+                         pprTypeApp, funResultTy )
 import Id              ( Id, idType, isImplicitId, isDeadBinder,
                           isExportedId, isLocalId, isGlobalId,
                           isRecordSelector, recordSelectorFieldLabel,
@@ -231,7 +244,7 @@ import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import Module
 import UniqFM
-import PackageConfig    ( PackageId, stringToPackageId )
+import PackageConfig    ( PackageId, stringToPackageId, mainPackageId )
 import FiniteMap
 import Panic
 import Digraph
@@ -315,9 +328,8 @@ defaultErrorHandler dflags inner =
 defaultCleanupHandler :: DynFlags -> IO a -> IO a
 defaultCleanupHandler dflags inner = 
     -- make sure we clean up after ourselves
-    later (unless (dopt Opt_KeepTmpFiles dflags) $
-               do cleanTempFiles dflags
-                  cleanTempDirs dflags
+    later (do cleanTempFiles dflags
+              cleanTempDirs dflags
           )
           -- exceptions will be blocked while we clean the temporary files,
           -- so there shouldn't be any difficulty if we receive further
@@ -325,20 +337,24 @@ 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
--- code".
-newSession :: GhcMode -> Maybe FilePath -> IO Session
-newSession mode mb_top_dir = do
+newSession :: Maybe FilePath -> IO Session
+newSession mb_top_dir = do
   -- catch ^C
   main_thread <- myThreadId
-  putMVar interruptTargetThread [main_thread]
+  modifyMVar_ interruptTargetThread (return . (main_thread :))
   installSignalHandlers
 
   dflags0 <- initSysTools mb_top_dir defaultDynFlags
   dflags  <- initDynFlags dflags0
-  env <- newHscEnv dflags{ ghcMode=mode }
+  env <- newHscEnv dflags
   ref <- newIORef env
   return (Session ref)
 
@@ -499,10 +515,9 @@ depanal (Session ref) excluded_mods allow_dup_roots = do
         old_graph = hsc_mod_graph hsc_env
        
   showPass dflags "Chasing dependencies"
-  when (gmode == BatchCompile) $
-       debugTraceMsg dflags 2 (hcat [
-                    text "Chasing modules from: ",
-                       hcat (punctuate comma (map pprTarget targets))])
+  debugTraceMsg dflags 2 (hcat [
+            text "Chasing modules from: ",
+            hcat (punctuate comma (map pprTarget targets))])
 
   r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
   case r of
@@ -581,8 +596,7 @@ load2 s@(Session ref) how_much mod_graph = do
        let
            -- check the stability property for each module.
            stable_mods@(stable_obj,stable_bco)
-               | BatchCompile <- ghci_mode = ([],[])
-               | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
+               = checkStability hpt1 mg2_with_srcimps all_home_mods
 
            -- prune bits of the HPT which are definitely redundant now,
            -- to save space.
@@ -690,13 +704,16 @@ load2 s@(Session ref) how_much mod_graph = do
                a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
                do_linking = a_root_is_Main || no_hs_main
 
-             when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
-               debugTraceMsg dflags 1 (text ("Warning: output was redirected with -o, " ++
-                                             "but no output will be generated\n" ++
-                                             "because there is no " ++ moduleNameString (moduleName main_mod) ++ " module."))
+             when (ghcLink dflags == LinkBinary 
+                    && isJust ofile && not do_linking) $
+               debugTraceMsg dflags 1 $
+                    text ("Warning: output was redirected with -o, " ++
+                          "but no output will be generated\n" ++
+                         "because there is no " ++ 
+                          moduleNameString (moduleName main_mod) ++ " module.")
 
              -- link everything together
-              linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
+              linkresult <- link (ghcLink dflags) dflags do_linking (hsc_HPT hsc_env1)
 
              loadFinish Succeeded linkresult ref hsc_env1
 
@@ -726,7 +743,7 @@ load2 s@(Session ref) how_much mod_graph = do
                        (eltsUFM (hsc_HPT hsc_env))) do
        
              -- Link everything together
-              linkresult <- link ghci_mode dflags False hpt4
+              linkresult <- link (ghcLink dflags) dflags False hpt4
 
              let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
              loadFinish Failed linkresult ref hsc_env4
@@ -824,6 +841,9 @@ checkModule session@(Session ref) mod = do
                                                      md_exports details,
                                minf_rdr_env   = Just rdr_env,
                                minf_instances = md_insts details
+#ifdef GHCI
+                               ,minf_modBreaks = emptyModBreaks 
+#endif
                              }
                   return (Just (CheckedModule {
                                        parsedSource = parsed,
@@ -836,15 +856,13 @@ checkModule session@(Session ref) mod = do
 
 unload :: HscEnv -> [Linkable] -> IO ()
 unload hsc_env stable_linkables        -- Unload everthing *except* 'stable_linkables'
-  = case ghcMode (hsc_dflags hsc_env) of
-       BatchCompile  -> return ()
-       JustTypecheck -> return ()
+  = case ghcLink (hsc_dflags hsc_env) of
 #ifdef GHCI
-       Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
+       LinkInMemory -> Linker.unload (hsc_dflags hsc_env) stable_linkables
 #else
-       Interactive -> panic "unload: no interpreter"
+       LinkInMemory -> panic "unload: no interpreter"
 #endif
-       other -> panic "unload: strange mode"
+       other -> return ()
 
 -- -----------------------------------------------------------------------------
 -- checkStability
@@ -861,9 +879,6 @@ unload hsc_env stable_linkables     -- Unload everthing *except* 'stable_linkables'
      module.  So we need to know that we will definitely not be recompiling
      any of these modules, and we can use the object code.
 
-  NB. stability is of no importance to BatchCompile at all, only Interactive.
-  (ToDo: what about JustTypecheck?)
-
   The stability check is as follows.  Both stableObject and
   stableBCO are used during the upsweep phase later.
 
@@ -882,7 +897,7 @@ unload hsc_env stable_linkables     -- Unload everthing *except* 'stable_linkables'
 
   These properties embody the following ideas:
 
-    - if a module is stable:
+    - if a module is stable, then:
        - if it has been compiled in a previous pass (present in HPT)
          then it does not need to be compiled or re-linked.
         - if it has not been compiled in a previous pass,
@@ -1093,95 +1108,133 @@ upsweep_mod :: HscEnv
             -> IO (Maybe HomeModInfo)  -- Nothing => Failed
 
 upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
-   = do 
-        let 
-           this_mod_name = ms_mod_name summary
+   =    let 
+                   this_mod_name = ms_mod_name summary
            this_mod    = ms_mod summary
            mb_obj_date = ms_obj_date summary
            obj_fn      = ml_obj_file (ms_location summary)
            hs_date     = ms_hs_date summary
 
+           is_stable_obj = this_mod_name `elem` stable_obj
+           is_stable_bco = this_mod_name `elem` stable_bco
+
+           old_hmi = lookupUFM old_hpt this_mod_name
+
+            -- We're using the dflags for this module now, obtained by
+            -- applying any options in its LANGUAGE & OPTIONS_GHC pragmas.
+            dflags = ms_hspp_opts summary
+            prevailing_target = hscTarget (hsc_dflags hsc_env)
+            local_target      = hscTarget dflags
+
+            -- If OPTIONS_GHC contains -fasm or -fvia-C, be careful that
+            -- we don't do anything dodgy: these should only work to change
+            -- from -fvia-C to -fasm and vice-versa, otherwise we could 
+            -- end up trying to link object code to byte code.
+            target = if prevailing_target /= local_target
+                        && (not (isObjectTarget prevailing_target)
+                            || not (isObjectTarget local_target))
+                        then prevailing_target
+                        else local_target 
+
+            -- store the corrected hscTarget into the summary
+            summary' = summary{ ms_hspp_opts = dflags { hscTarget = target } }
+
+           -- The old interface is ok if
+           --  a) we're compiling a source file, and the old HPT
+           --     entry is for a source file
+           --  b) we're compiling a hs-boot file
+           -- Case (b) allows an hs-boot file to get the interface of its
+           -- real source file on the second iteration of the compilation
+           -- manager, but that does no harm.  Otherwise the hs-boot file
+           -- will always be recompiled
+            
+            mb_old_iface 
+               = case old_hmi of
+                    Nothing                              -> Nothing
+                    Just hm_info | isBootSummary summary -> Just iface
+                                 | not (mi_boot iface)   -> Just iface
+                                 | otherwise             -> Nothing
+                                  where 
+                                    iface = hm_iface hm_info
+
            compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
            compile_it  = upsweep_compile hsc_env old_hpt this_mod_name 
-                               summary mod_index nmods
-
-       case ghcMode (hsc_dflags hsc_env) of
-           BatchCompile ->
-               case () of
-                  -- Batch-compilating is easy: just check whether we have
-                  -- an up-to-date object file.  If we do, then the compiler
-                  -- needs to do a recompilation check.
-                  _ | Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
-                          linkable <- 
-                               findObjectLinkable this_mod obj_fn obj_date
-                          compile_it (Just linkable)
-
-                    | otherwise ->
-                          compile_it Nothing
-
-           interactive ->
-               case () of
-                   _ | is_stable_obj, isJust old_hmi ->
-                          return old_hmi
+                               summary' mod_index nmods mb_old_iface
+
+            compile_it_discard_iface 
+                        = upsweep_compile hsc_env old_hpt this_mod_name 
+                               summary' mod_index nmods Nothing
+
+        in
+       case target of
+
+            _any
+                -- Regardless of whether we're generating object code or
+                -- byte code, we can always use an existing object file
+                -- if it is *stable* (see checkStability).
+               | is_stable_obj, isJust old_hmi ->
+                       return old_hmi
                        -- object is stable, and we have an entry in the
                        -- old HPT: nothing to do
 
-                     | is_stable_obj, isNothing old_hmi -> do
-                          linkable <-
-                               findObjectLinkable this_mod obj_fn 
+               | is_stable_obj, isNothing old_hmi -> do
+                       linkable <- findObjectLinkable this_mod obj_fn 
                                        (expectJust "upseep1" mb_obj_date)
-                          compile_it (Just linkable)
+                       compile_it (Just linkable)
                        -- object is stable, but we need to load the interface
                        -- off disk to make a HMI.
 
-                     | is_stable_bco -> 
-                          ASSERT(isJust old_hmi) -- must be in the old_hpt
-                          return old_hmi
+            HscInterpreted
+               | is_stable_bco -> 
+                       ASSERT(isJust old_hmi) -- must be in the old_hpt
+                       return old_hmi
                        -- BCO is stable: nothing to do
 
-                     | Just hmi <- old_hmi,
-                       Just l <- hm_linkable hmi, not (isObjectLinkable l),
-                       linkableTime l >= ms_hs_date summary ->
-                          compile_it (Just l)
+               | Just hmi <- old_hmi,
+                 Just l <- hm_linkable hmi, not (isObjectLinkable l),
+                 linkableTime l >= ms_hs_date summary ->
+                       compile_it (Just l)
                        -- we have an old BCO that is up to date with respect
                        -- to the source: do a recompilation check as normal.
 
-                     | otherwise ->
-                         compile_it Nothing
+               | otherwise -> 
+                        compile_it Nothing
                        -- no existing code at all: we must recompile.
-                  where
-                   is_stable_obj = this_mod_name `elem` stable_obj
-                   is_stable_bco = this_mod_name `elem` stable_bco
 
-                   old_hmi = lookupUFM old_hpt this_mod_name
+              -- When generating object code, if there's an up-to-date
+              -- object file on the disk, then we can use it.
+              -- However, if the object file is new (compared to any
+              -- linkable we had from a previous compilation), then we
+              -- must discard any in-memory interface, because this
+              -- means the user has compiled the source file
+              -- separately and generated a new interface, that we must
+              -- read from the disk.
+              --
+            obj | isObjectTarget obj,
+                 Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
+                     case old_hmi of
+                        Just hmi 
+                          | Just l <- hm_linkable hmi,
+                            isObjectLinkable l && linkableTime l == obj_date
+                            -> compile_it (Just l)
+                        _otherwise -> do
+                         linkable <- findObjectLinkable this_mod obj_fn obj_date
+                          compile_it_discard_iface (Just linkable)
+
+           _otherwise ->
+                 compile_it Nothing
+
 
 -- Run hsc to compile a module
 upsweep_compile hsc_env old_hpt this_mod summary
                 mod_index nmods
-                mb_old_linkable = do
-  let
-       -- The old interface is ok if it's in the old HPT 
-       --      a) we're compiling a source file, and the old HPT
-       --         entry is for a source file
-       --      b) we're compiling a hs-boot file
-       -- Case (b) allows an hs-boot file to get the interface of its
-       -- real source file on the second iteration of the compilation
-       -- manager, but that does no harm.  Otherwise the hs-boot file
-       -- will always be recompiled
-
-        mb_old_iface 
-               = case lookupUFM old_hpt this_mod of
-                    Nothing                              -> Nothing
-                    Just hm_info | isBootSummary summary -> Just iface
-                                 | not (mi_boot iface)   -> Just iface
-                                 | otherwise             -> Nothing
-                                  where 
-                                    iface = hm_iface hm_info
-
-  compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
+                mb_old_iface
+                mb_old_linkable
+ = do
+   compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
                         mod_index nmods
 
-  case compresult of
+   case compresult of
         -- Compilation failed.  Compile may still have updated the PCS, tho.
         CompErrs -> return Nothing
 
@@ -1733,6 +1786,9 @@ data ModuleInfo = ModuleInfo {
        minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
        minf_rdr_env   :: Maybe GlobalRdrEnv,   -- Nothing for a compiled/package mod
        minf_instances :: [Instance]
+#ifdef GHCI
+        ,minf_modBreaks :: ModBreaks 
+#endif
        -- ToDo: this should really contain the ModIface too
   }
        -- We don't want HomeModInfo here, because a ModuleInfo applies
@@ -1756,22 +1812,23 @@ getModuleInfo s mdl = withSession s $ \hsc_env -> do
 getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
 getPackageModuleInfo hsc_env mdl = do
 #ifdef GHCI
-  (_msgs, mb_names) <- getModuleExports hsc_env mdl
-  case mb_names of
+  (_msgs, mb_avails) <- getModuleExports hsc_env mdl
+  case mb_avails of
     Nothing -> return Nothing
-    Just names -> do
+    Just avails -> do
        eps <- readIORef (hsc_EPS hsc_env)
        let 
+            names  = availsToNameSet avails
            pte    = eps_PTE eps
-           n_list = nameSetToList names
-           tys    = [ ty | name <- n_list,
+           tys    = [ ty | name <- concatMap availNames avails,
                            Just ty <- [lookupTypeEnv pte name] ]
        --
        return (Just (ModuleInfo {
                        minf_type_env  = mkTypeEnv tys,
                        minf_exports   = names,
                        minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
-                       minf_instances = error "getModuleInfo: instances for package module unimplemented"
+                       minf_instances = error "getModuleInfo: instances for package module unimplemented",
+                        minf_modBreaks = emptyModBreaks  
                }))
 #else
   -- bogusly different for non-GHCI (ToDo)
@@ -1788,6 +1845,9 @@ getHomeModuleInfo hsc_env mdl =
                        minf_exports   = availsToNameSet (md_exports details),
                        minf_rdr_env   = mi_globals $! hm_iface hmi,
                        minf_instances = md_insts details
+#ifdef GHCI
+                       ,minf_modBreaks = md_modBreaks details  
+#endif
                        }))
 
 -- | The list of top-level entities defined in a module
@@ -1821,6 +1881,10 @@ modInfoLookupName s minf name = withSession s $ \hsc_env -> do
        return $! lookupType (hsc_dflags hsc_env) 
                            (hsc_HPT hsc_env) (eps_PTE eps) name
 
+#ifdef GHCI
+modInfoModBreaks = minf_modBreaks  
+#endif
+
 isDictonaryId :: Id -> Bool
 isDictonaryId id
   = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
@@ -1886,7 +1950,7 @@ findModule' hsc_env mod_name maybe_pkg =
   case lookupUFM hpt mod_name of
     Just mod_info -> return (mi_module (hm_iface mod_info))
     _not_a_home_module -> do
-         res <- findImportedModule hsc_env mod_name Nothing
+         res <- findImportedModule hsc_env mod_name maybe_pkg
          case res of
            Found _ m | modulePackageId m /= this_pkg -> return m
                      | otherwise -> throwDyn (CmdLineError (showSDoc $
@@ -1906,7 +1970,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
@@ -1918,15 +1982,14 @@ setContext (Session ref) toplev_mods export_mods = do
                                            ic_exports      = export_mods,
                                            ic_rn_gbl_env   = all_env }}
 
-
 -- Make a GlobalRdrEnv based on the exports of the modules only.
 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
 mkExportEnv hsc_env mods = do
   stuff <- mapM (getModuleExports hsc_env) mods
   let 
        (_msgs, mb_name_sets) = unzip stuff
-       gres = [ nameSetToGlobalRdrEnv name_set (moduleName mod)
-              | (Just name_set, mod) <- zip mb_name_sets mods ]
+       gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
+              | (Just avails, mod) <- zip mb_name_sets mods ]
   --
   return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
 
@@ -2088,14 +2151,22 @@ data RunResult
   = RunOk [Name]               -- ^ names bound by this evaluation
   | RunFailed                  -- ^ statement failed compilation
   | RunException Exception     -- ^ statement raised an exception
+  | forall a . RunBreak a ThreadId BreakInfo (IO RunResult)
+
+data Status a
+   = Break RunResult               -- ^ the computation hit a breakpoint
+   | Complete (Either Exception a) -- ^ the computation completed with either an exception or a value
 
--- | Run a statement in the current interactive context.  Statemenet
+-- | Run a statement in the current interactive context.  Statement
 -- may bind multple values.
 runStmt :: Session -> String -> IO RunResult
 runStmt (Session ref) expr
    = do 
        hsc_env <- readIORef ref
 
+        breakMVar  <- newEmptyMVar  -- wait on this when we hit a breakpoint
+        statusMVar <- newEmptyMVar  -- wait on this when a computation is running 
+
        -- Turn off -fwarn-unused-bindings when running a statement, to hide
        -- warnings about the implicit bindings we introduce.
        let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
@@ -2107,36 +2178,58 @@ runStmt (Session ref) expr
           Nothing -> return RunFailed
           Just (new_hsc_env, names, hval) -> do
 
-               let thing_to_run = unsafeCoerce# hval :: IO [HValue]
-               either_hvals <- sandboxIO thing_to_run
-
+              -- resume says what to do when we continue execution from a breakpoint
+              -- onBreakAction says what to do when we hit a breakpoint
+              -- they are mutually recursive, hence the strange use tuple let-binding 
+              let (resume, onBreakAction)
+                     = ( do stablePtr <- newStablePtr onBreakAction 
+                            poke breakPointIOAction stablePtr
+                            putMVar breakMVar ()
+                            status <- takeMVar statusMVar
+                            switchOnStatus ref new_hsc_env names status
+                       , \ids apStack -> do 
+                            tid <- myThreadId
+                            putMVar statusMVar (Break (RunBreak apStack tid ids resume))
+                            takeMVar breakMVar 
+                       )
+
+              -- set the onBreakAction to be performed when we hit a breakpoint
+              -- this is visible in the Byte Code Interpreter, thus it is a global
+              -- variable, implemented with stable pointers
+              stablePtr <- newStablePtr onBreakAction
+              poke breakPointIOAction stablePtr
+
+              let thing_to_run = unsafeCoerce# hval :: IO [HValue]
+              status <- sandboxIO statusMVar thing_to_run
+              freeStablePtr stablePtr -- be careful not to leak stable pointers!
+              switchOnStatus ref new_hsc_env names status
+   where
+   switchOnStatus ref hs_env names status = 
+      case status of  
+         -- did we hit a breakpoint or did we complete?
+         (Break result) -> return result 
+         (Complete either_hvals) ->
                case either_hvals of
-                   Left e -> do
-                       -- on error, keep the *old* interactive context,
-                       -- so that 'it' is not bound to something
-                       -- that doesn't exist.
-                       return (RunException e)
-
+                   Left e -> return (RunException e)
                    Right hvals -> do
-                       -- Get the newly bound things, and bind them.  
-                       -- Don't need to delete any shadowed bindings;
-                       -- the new ones override the old ones. 
                        extendLinkEnv (zip names hvals)
-                       
-                       writeIORef ref new_hsc_env
+                       writeIORef ref hs_env 
                        return (RunOk names)
+           
+-- this points to the IO action that is executed when a breakpoint is hit
+foreign import ccall "&breakPointIOAction" 
+        breakPointIOAction :: Ptr (StablePtr (a -> BreakInfo -> IO ())) 
 
 -- When running a computation, we redirect ^C exceptions to the running
 -- thread.  ToDo: we might want a way to continue even if the target
 -- thread doesn't die when it receives the exception... "this thread
 -- is not responding".
-sandboxIO :: IO a -> IO (Either Exception a)
-sandboxIO thing = do
-  m <- newEmptyMVar
+sandboxIO :: MVar (Status a) -> IO a -> IO (Status a) 
+sandboxIO statusMVar thing = do
   ts <- takeMVar interruptTargetThread
-  child <- forkIO (do res <- Exception.try thing; putMVar m res)
+  child <- forkIO (do res <- Exception.try thing; putMVar statusMVar (Complete res))
   putMVar interruptTargetThread (child:ts)
-  takeMVar m `finally` modifyMVar_ interruptTargetThread (return.tail)
+  takeMVar statusMVar `finally` modifyMVar_ interruptTargetThread (return.tail)
 
 {-
 -- This version of sandboxIO runs the expression in a completely new
@@ -2163,17 +2256,36 @@ sandboxIO thing = do
 foreign import "rts_evalStableIO"  {- safe -}
   rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
   -- more informative than the C type!
+
+XXX the type of rts_evalStableIO no longer matches the above
+
 -}
 
+
 -----------------------------------------------------------------------------
 -- show a module and it's source/object filenames
 
 showModule :: Session -> ModSummary -> IO String
-showModule s mod_summary = withSession s $ \hsc_env -> do
+showModule s mod_summary = withSession s $                        \hsc_env -> 
+                           isModuleInterpreted s mod_summary >>=  \interpreted -> 
+                           return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
+
+isModuleInterpreted :: Session -> ModSummary -> IO Bool
+isModuleInterpreted s mod_summary = withSession s $ \hsc_env -> 
   case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
        Nothing       -> panic "missing linkable"
-       Just mod_info -> return (showModMsg (hscTarget (hsc_dflags hsc_env)) (not obj_linkable) mod_summary)
+       Just mod_info -> return (not obj_linkable)
                      where
                         obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 
+obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
+obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
+
+obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
+obtainTerm sess force id = withSession sess $ \hsc_env -> do
+              mb_v <- getHValue (varName id) 
+              case mb_v of
+                Just v  -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
+                Nothing -> return Nothing
+
 #endif /* GHCI */