-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.85 2001/08/13 15:49:37 simonmar Exp $
+-- $Id: InteractiveUI.hs,v 1.88 2001/08/15 15:39:59 simonmar Exp $
--
-- GHC Interactive User Interface
--
import Packages
import CompManager
-import HscTypes ( GhciMode(..) )
+import HscTypes ( GhciMode(..), TyThing(..) )
import MkIface ( ifaceTyCls )
import ByteCodeLink
import DriverFlags
import Linker
import Finder ( flushPackageCache )
import Util
-import Name ( Name )
+import Id ( isRecordSelector, isDataConWrapId, idName )
+import Class ( className )
+import TyCon ( tyConName )
+import SrcLoc ( isGoodSrcLoc )
+import Name ( Name, isHomePackageName, nameSrcLoc )
import Outputable
import CmdLineOpts ( DynFlag(..), getDynFlags, saveDynFlags, restoreDynFlags, dopt_unset )
import Panic ( GhcException(..) )
\ :cd <dir> change directory to <dir>\n\
\ :def <cmd> <expr> define a command :<cmd>\n\
\ :help, :? display this list of commands\n\
-\ :info [<name> ...] display information about the given names, or\n\
-\ about currently loaded files if no names given\n\
+\ :info [<name> ...] display information about the given names\n\
\ :load <filename> ... load module(s) and their dependents\n\
\ :module <mod> set the context for expression evaluation to <mod>\n\
\ :reload reload the current module set\n\
info "" = throwDyn (CmdLineError "syntax: `:i <thing-you-want-info-about>'")
info s = do
let names = words s
- st <- getGHCiState
- let cmst = cmstate st
+ state <- getGHCiState
dflags <- io getDynFlags
- things <- io (mapM (cmInfoThing cmst dflags) names)
- let real_things = [ x | Just x <- things ]
- let descs = map (`ifaceTyCls` []) real_things
- let strings = map (showSDoc . ppr) descs
- io (mapM_ putStr strings)
+ let
+ infoThings cms [] = return cms
+ infoThings cms (name:names) = do
+ (cms, unqual, ty_things) <- io (cmInfoThing cms dflags name)
+ io (putStrLn (showSDocForUser unqual (
+ vcat (intersperse (text "") (map showThing ty_things))))
+ )
+ infoThings cms names
+
+ showThing ty_thing = vcat [ text "-- " <> showTyThing ty_thing,
+ ppr (ifaceTyCls ty_thing) ]
+
+ showTyThing (AClass cl)
+ = hcat [ppr cl, text " is a class", showSrcLoc (className cl)]
+ showTyThing (ATyCon ty)
+ = hcat [ppr ty, text " is a type constructor", showSrcLoc (tyConName ty)]
+ showTyThing (AnId id)
+ = hcat [ppr id, text " is a ", text (idDescr id), showSrcLoc (idName id)]
+
+ idDescr id
+ | isRecordSelector id = "record selector"
+ | isDataConWrapId id = "data constructor"
+ | otherwise = "variable"
+
+ -- also print out the source location for home things
+ showSrcLoc name
+ | isHomePackageName name && isGoodSrcLoc loc
+ = hsep [ text ", defined at", ppr loc ]
+ | otherwise
+ = empty
+ where loc = nameSrcLoc name
+
+ cms <- infoThings (cmstate state) names
+ setGHCiState state{ cmstate = cms }
+ return ()
+
addModule :: String -> GHCi ()
addModule str = do