X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FDebugger.hs;h=5ae7db8caacc319ce80c9846c287d18dfe50062e;hb=07e3238de5aff7456a5e8e4b5ba39040dae6806a;hp=d31d4d67d157d8428bdd2c713fad02d5b0fce26e;hpb=385f8691f068c13d480a50c0be56b96493f96976;p=ghc-hetmet.git

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index d31d4d6..5ae7db8 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -10,7 +10,7 @@
 -- 
 -----------------------------------------------------------------------------
 
-module Debugger (pprintClosureCommand, showTerm) where
+module Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where
 
 import Linker
 import RtClosureInspect
@@ -28,8 +28,8 @@ import GHC
 import DynFlags
 import InteractiveEval
 import Outputable
-import Pretty                    ( Mode(..), showDocWith )
 import SrcLoc
+import PprTyThing
 
 import Control.Exception
 import Control.Monad
@@ -61,10 +61,8 @@ pprintClosureCommand session bindThings force str = do
                                 (map skolemiseSubst substs)}
   -- Finally, print the Terms
   unqual  <- GHC.getPrintUnqual session
-  let showSDocForUserOneLine unqual doc =
-               showDocWith LeftMode (doc (mkErrStyle unqual))
   docterms <- mapM (showTerm session) terms
-  (putStrLn . showSDocForUserOneLine unqual . vcat)
+  (printForUser stdout unqual . vcat)
         (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
                  ids
                  docterms)
@@ -81,7 +79,7 @@ pprintClosureCommand session bindThings force str = do
      --  Then, we extract a substitution,
      --  mapping the old tyvars to the reconstructed types.
        let Just reconstructed_type = termType term
-           Just subst = computeRTTIsubst (idType id) (reconstructed_type)
+           subst = computeRTTIsubst (idType id) (reconstructed_type)
        return (term',subst)
 
    tidyTermTyVars :: Session -> Term -> IO Term
@@ -199,3 +197,18 @@ newGrimName userName  = do
         occname = mkOccName varName userName
         name    = mkInternalName unique occname noSrcSpan
     return name
+
+pprTypeAndContents :: Session -> [Id] -> IO SDoc
+pprTypeAndContents session ids = do
+  dflags  <- GHC.getSessionDynFlags session
+  let pefas     = dopt Opt_PrintExplicitForalls dflags
+      pcontents = dopt Opt_PrintBindContents dflags
+  if pcontents 
+    then do
+      let depthBound = 100
+      terms      <- mapM (GHC.obtainTermB session depthBound False) ids
+      docs_terms <- mapM (showTerm session) terms
+      return $ vcat $ zipWith (\ty cts -> ty <+> equals <+> cts)
+                             (map (pprTyThing pefas . AnId) ids)
+                             docs_terms
+    else return $  vcat $ map (pprTyThing pefas . AnId) ids