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

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 25ad9d8..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
@@ -993,8 +995,8 @@ afterLoad ok session maybe_context = do
      Just (as,bs) -> do
         r <- io $ Exception.try (GHC.setContext session as bs)
         case r of
-           Left err -> setContextAfterLoad session loaded_mods
-           Right _  -> return ()
+           Left _err -> setContextAfterLoad session loaded_mods
+           Right _   -> return ()
 
   modulesLoadedMsg ok (map GHC.ms_mod_name loaded_mods)
 
@@ -1453,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