X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=dd75a09e320f3166604a82639c580d8e04df12e6;hb=96b4db39ccb5c3d37c555c49e1dbe9baf0421298;hp=83b59660899d416b12d237e6ac28e6b19f0bfb1e;hpb=da4dda13a3faf2ecc2138d16b7faa79cff264037;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 83b5966..dd75a09 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -19,7 +19,7 @@ import Debugger
 import qualified GHC
 import GHC              ( Session, LoadHowMuch(..), Target(..),  TargetId(..),
                           Module, ModuleName, TyThing(..), Phase,
-                          BreakIndex, SrcSpan, Resume, SingleStep )
+                          BreakIndex, SrcSpan, Resume, SingleStep, Id )
 import PprTyThing
 import DynFlags
 
@@ -631,7 +631,11 @@ afterRunStmt step_here run_result = do
                printForUser $ ptext SLIT("Stopped at") <+> 
                        ppr (GHC.resumeSpan $ head resumes)
 --               printTypeOfNames session names
-               printTypeAndContentOfNames session names
+               let namesSorted = sortBy compareNames names
+               tythings <- catMaybes `liftM` 
+                              io (mapM (GHC.lookupName session) namesSorted)
+
+               printTypeAndContents session [id | AnId id <- tythings]
                maybe (return ()) runBreakCmd mb_info
                -- run the command set with ":set stop <cmd>"
                st <- getGHCiState
@@ -648,19 +652,6 @@ afterRunStmt step_here run_result = do
 
   return (case run_result of GHC.RunOk _ -> True; _ -> False)
 
-      where printTypeAndContentOfNames session names = do
-              let namesSorted = sortBy compareNames names
-              tythings <- catMaybes `liftM` 
-                              io (mapM (GHC.lookupName session) namesSorted)
-	      let ids = [id | AnId id <- tythings]
-              terms <- mapM (io . GHC.obtainTermB session 10 False) ids
-              docs_terms <- mapM (io . showTerm session) terms                                   
-	      dflags <- getDynFlags
-	      let pefas = dopt Opt_PrintExplicitForalls dflags
-              printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
-                                            (map (pprTyThing pefas . AnId) ids)
-                                            docs_terms
-
 runBreakCmd :: GHC.BreakInfo -> GHCi ()
 runBreakCmd info = do
   let mod = GHC.breakInfo_module info
@@ -688,6 +679,17 @@ printTypeOfName session n
             Nothing    -> return ()
             Just thing -> printTyThing thing
 
+printTypeAndContents :: Session -> [Id] -> GHCi ()
+printTypeAndContents session ids = do
+              terms <- mapM (io . GHC.obtainTermB session 10 False) ids
+              docs_terms <- mapM (io . showTerm session) terms                                   
+	      dflags <- getDynFlags
+	      let pefas = dopt Opt_PrintExplicitForalls dflags
+              printForUser $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+                                            (map (pprTyThing pefas . AnId) ids)
+                                            docs_terms
+
+
 specialCommand :: String -> GHCi Bool
 specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
 specialCommand str = do
@@ -798,7 +800,7 @@ addModule files = do
   session <- getSession
   io (mapM_ (GHC.addTarget session) targets)
   ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
+  afterLoad ok session Nothing
 
 changeDirectory :: String -> GHCi ()
 changeDirectory dir = do
@@ -941,7 +943,7 @@ loadModule' files = do
   -- as a ToDo for now.
 
   io (GHC.setTargets session targets)
-  doLoad session LoadAllTargets
+  doLoad session False LoadAllTargets
 
 checkModule :: String -> GHCi ()
 checkModule m = do
@@ -959,30 +961,43 @@ checkModule m = do
 			(text "global names: " <+> ppr global) $$
 		        (text "local  names: " <+> ppr local)
 	   _ -> empty))
-  afterLoad (successIf (isJust result)) session
+  afterLoad (successIf (isJust result)) session Nothing
 
 reloadModule :: String -> GHCi ()
 reloadModule m = do
   session <- getSession
-  doLoad session $ if null m then LoadAllTargets 
-                             else LoadUpTo (GHC.mkModuleName m)
+  doLoad session True $ if null m then LoadAllTargets 
+                                  else LoadUpTo (GHC.mkModuleName m)
   return ()
 
-doLoad :: Session -> LoadHowMuch -> GHCi SuccessFlag
-doLoad session howmuch = do
+doLoad :: Session -> Bool -> LoadHowMuch -> GHCi SuccessFlag
+doLoad session retain_context howmuch = do
   -- turn off breakpoints before we load: we can't turn them off later, because
   -- the ModBreaks will have gone away.
   discardActiveBreakPoints
+  context <- io $ GHC.getContext session
   ok <- io (GHC.load session howmuch)
-  afterLoad ok session
+  afterLoad ok session (if retain_context then Just context else Nothing)
   return ok
 
-afterLoad :: SuccessFlag -> Session -> GHCi ()
-afterLoad ok session = do
+afterLoad :: SuccessFlag -> Session -> Maybe ([Module],[Module]) -> GHCi ()
+afterLoad ok session maybe_context = do
   io (revertCAFs)  -- always revert CAFs on load.
   discardTickArrays
   loaded_mods <- getLoadedModules session
-  setContextAfterLoad session loaded_mods
+
+  -- try to retain the old module context for :reload.  This might
+  -- not be possible, for example if some modules have gone away, so
+  -- we attempt to set the same context, backing off to the default
+  -- context if that fails.
+  case maybe_context of
+     Nothing -> setContextAfterLoad session loaded_mods
+     Just (as,bs) -> do
+        r <- io $ Exception.try (GHC.setContext session as bs)
+        case r of
+           Left _err -> setContextAfterLoad session loaded_mods
+           Right _   -> return ()
+
   modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
 
 setContextAfterLoad :: Session -> [GHC.ModSummary] -> GHCi ()
@@ -1184,14 +1199,10 @@ separate :: Session -> [String] -> [Module] -> [Module]
         -> GHCi ([Module],[Module])
 separate _       []             as bs = return (as,bs)
 separate session (('*':str):ms) as bs = do
-   m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
-   b <- io $ GHC.moduleIsInterpreted session m
-   if b then separate session ms (m:as) bs
-   	else throwDyn (CmdLineError ("module '"
-                        ++ GHC.moduleNameString (GHC.moduleName m)
-                        ++ "' is not interpreted"))
+  m <- wantInterpretedModule str
+  separate session ms (m:as) bs
 separate session (str:ms) as bs = do
-  m <- io $ GHC.findModule session (GHC.mkModuleName str) Nothing
+  m <- lookupModule str
   separate session ms as (m:bs)
 
 newContext :: [String] -> GHCi ()
@@ -1444,8 +1455,7 @@ showBindings :: GHCi ()
 showBindings = do
   s <- getSession
   bindings <- io (GHC.getBindings s)
-  mapM_ printTyThing $ sortBy compareTyThings bindings
-  return ()
+  printTypeAndContents s [ id | AnId id <- sortBy compareTyThings bindings]
 
 compareTyThings :: TyThing -> TyThing -> Ordering
 t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2