X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=dd75a09e320f3166604a82639c580d8e04df12e6;hp=74310a340df57a03742180a38783cb0766e26fa0;hb=96b4db39ccb5c3d37c555c49e1dbe9baf0421298;hpb=876a71215ce555d1830aacc51076595a835ad699 diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 74310a3..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 " 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 @@ -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