X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FInteractiveUI.hs;h=9a885ab92bcccbdb8f767435bbf083fc1ca414f2;hb=4e3255388e8b99ccdae290bfcb6cd666b8c93d4a;hp=38b24854cf67149a9b94593ac27a95aa351ce76c;hpb=d32c5227315009f38355fe3233f0f4e5b1f61dc6;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 38b2485..9a885ab 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -#include "Linker.h" #-}
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.173 2004/08/13 13:06:42 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.174 2004/08/16 09:53:57 simonpj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -19,7 +19,7 @@ import CompManager
 import HscTypes		( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
 			  isObjectLinkable, GhciMode(..) )
 import IfaceSyn		( IfaceType, IfaceDecl(..), IfaceClassOp(..), IfaceConDecls(..), IfaceConDecl(..), 
-		   	  pprIfaceDeclHead, pprParendIfaceType, pprIfaceForAllPart )
+		   	  IfaceInst(..), pprIfaceDeclHead, pprParendIfaceType, pprIfaceForAllPart )
 import FunDeps		( pprFundeps )
 import DriverFlags
 import DriverState
@@ -478,23 +478,32 @@ info s  = do { let names = words s
 	     ; mapM_ (infoThing init_cms) names }
   where
     infoThing cms name
-	= do { stuff <- io (cmInfoThing cms name)
+	= do { stuff <- io (cmGetInfo cms name)
 	     ; io (putStrLn (showSDocForUser (cmGetPrintUnqual cms) $
-     		   vcat (intersperse (text "") (map (showThing name) stuff)))) }
-
-showThing :: String -> (IfaceDecl, Fixity, SrcLoc) -> SDoc
-showThing name (thing, fixity, src_loc) 
-    = vcat [ showDecl (\occ -> name == occNameUserString occ) thing, 
-	     showFixity fixity,
-	     text "-- " <> showLoc src_loc]
+     		   vcat (intersperse (text "") (map showThing stuff)))) }
+
+showThing :: GetInfoResult -> SDoc
+showThing  (wanted_str, (thing, fixity, src_loc, insts)) 
+    = vcat [ showDecl want_name thing, 
+	     show_fixity fixity,
+	     show_loc src_loc,
+	     vcat (map show_inst insts)]
   where
-    showFixity fix 
+    want_name occ = wanted_str == occNameUserString occ
+
+    show_fixity fix 
 	| fix == defaultFixity = empty
-	| otherwise            = ppr fix <+> text name
+	| otherwise            = ppr fix <+> text wanted_str
+
+    show_loc loc	-- The ppr function for SrcLocs is a bit wonky
+	| isGoodSrcLoc loc = comment <+> ptext SLIT("Defined at") <+> ppr loc
+	| otherwise	   = comment <+> ppr loc
+    comment = ptext SLIT("--")
 
-    showLoc loc	-- The ppr function for SrcLocs is a bit wonky
-	| isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
-	| otherwise	   = ppr loc
+    show_inst (iface_inst, loc)
+	= hang (ptext SLIT("instance") <+> ppr (ifInstHead iface_inst))
+	     2 (char '\t' <> show_loc loc)
+		-- The tab tries to make them line up a bit
 
 -- Now there is rather a lot of goop just to print declarations in a
 -- civilised way with "..." for the parts we are less interested in.