[project @ 2004-08-16 09:53:47 by simonpj]

[ghc-hetmet.git] / ghc / compiler / ghci / InteractiveUI.hs

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 3e0feaf..9a885ab 100644 (file)
--- 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.171 2004/08/12 13:06:51 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.174 2004/08/16 09:53:57 simonpj Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -12,14 +12,14 @@ module InteractiveUI (
        ghciWelcomeMsg
    ) where
 
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
 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
@@ -77,12 +77,12 @@ import System.Posix.Internals ( setNonBlockingFD )
 
 -----------------------------------------------------------------------------
 
-ghciWelcomeMsg = "\ 
-\   ___         ___ _\n\ 
-\  / _ \\ /\\  /\\/ __(_)\n\ 
-\ / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n\ 
-\/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n\ 
-\\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
+ghciWelcomeMsg =
+ "   ___         ___ _\n"++
+ "  / _ \\ /\\  /\\/ __(_)\n"++
+ " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
+ "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
+ "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
 
 GLOBAL_VAR(commands, builtin_commands, [(String, String -> GHCi Bool)])
 
@@ -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.