X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=dffae162d9124eddcdbd9cbcebaa8c2e37610c54;hb=98e1486635c889e023097d63da0c9b68393de1fd;hp=e868d14580606f34133733abe6bbbf43ea78ca59;hpb=8fcfc8d6e42ea5bf49422024bc71d3728ee97db9;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index e868d14..dffae16 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -186,7 +186,7 @@ helpText = " :sprint [ ...] simplifed version of :print\n" ++ " :step single-step after stopping at a breakpoint\n"++ " :step single-step into \n"++ - " :stepover (locally) single-step over function applications"++ + " :stepover single-step without following function applications\n"++ " :trace trace after stopping at a breakpoint\n"++ " :trace trace into (remembers breakpoints for :history)\n"++ @@ -578,7 +578,8 @@ afterRunStmt pred run_result = do pred (GHC.resumeSpan $ head resumes) -> do printForUser $ ptext SLIT("Stopped at") <+> ppr (GHC.resumeSpan $ head resumes) - printTypeOfNames session names +-- printTypeOfNames session names + printTypeAndContentOfNames session names maybe (return ()) runBreakCmd mb_info -- run the command set with ":set stop " st <- getGHCiState @@ -595,6 +596,18 @@ afterRunStmt pred 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) names) + docs_ty <- mapM showTyThing tythings + terms <- mapM (io . GHC.obtainTerm session False) + [ id | (AnId id, Just _) <- zip tythings docs_ty] + docs_terms <- mapM (io . showTerm session) terms + printForUser $ vcat $ zipWith (\ty cts -> ty <> text " = " <> cts) + (catMaybes docs_ty) + docs_terms + runBreakCmd :: GHC.BreakInfo -> GHCi () runBreakCmd info = do let mod = GHC.breakInfo_module info @@ -1276,11 +1289,18 @@ showBindings = do compareTyThings :: TyThing -> TyThing -> Ordering t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2 -printTyThing :: TyThing -> GHCi () -printTyThing (AnId id) = do +showTyThing :: TyThing -> GHCi (Maybe SDoc) +showTyThing (AnId id) = do ty' <- cleanType (GHC.idType id) - printForUser $ ppr id <> text " :: " <> ppr ty' -printTyThing _ = return () + return $ Just $ ppr id <> text " :: " <> ppr ty' +showTyThing _ = return Nothing + +printTyThing :: TyThing -> GHCi () +printTyThing tyth = do + mb_x <- showTyThing tyth + case mb_x of + Just x -> printForUser x + Nothing -> return () -- if -fglasgow-exts is on we show the foralls, otherwise we don't. cleanType :: Type -> GHCi Type