[project @ 2001-07-18 16:06:10 by rrt]

Add support for Hugs's :info command. Doesn't work yet, but shouldn't
interfere with anything else. Some of the files touched are just to correct
out-of-date comments.

Highlights are:

hscThing: like hscStmt, but just gets info about a single identifier
cmInfoThing: exposes hscThing's functionality to the outside world

ghc/compiler/compMan/CompManager.lhs

@@ -16,10 +16,12 @@ module CompManager (
     cmGetContext, -- :: CmState -> IO String
 
 #ifdef GHCI
-    cmRunStmt,	  --  :: CmState -> DynFlags -> String -> IO (CmState, [Name])
+    cmInfoThing,  -- :: CmState -> DynFlags -> String -> IO (Maybe TyThing)
 
-    cmTypeOfExpr, --  :: CmState -> DynFlags -> String
-		  --  -> IO (CmState, Maybe String)
+    cmRunStmt,	  -- :: CmState -> DynFlags -> String -> IO (CmState, [Name])
+
+    cmTypeOfExpr, -- :: CmState -> DynFlags -> String
+		  -- -> IO (CmState, Maybe String)
 
     cmTypeOfName, -- :: CmState -> Name -> IO (Maybe String)
 
@@ -39,7 +41,7 @@ import DriverFlags	( getDynFlags )
 import DriverPhases
 import DriverUtil
 import Finder
-import HscMain		( initPersistentCompilerState )
+import HscMain		( initPersistentCompilerState, hscThing )
 import HscTypes
 import RnEnv		( unQualInScope )
 import Id		( idType, idName )
@@ -170,6 +172,11 @@ moduleNameToModule mn
 -- cmRunStmt:  Run a statement/expr.
 
 #ifdef GHCI
+cmInfoThing :: CmState -> DynFlags -> String -> IO (Maybe TyThing)
+cmInfoThing CmState{ hst=hst, hit=hit, pcs=pcs, pls=pls, ic=icontext } dflags id
+   = do (pcs, thing) <- hscThing dflags hst hit pcs icontext id
+	return thing
+
 cmRunStmt :: CmState -> DynFlags -> String
 	-> IO (CmState,			-- new state
 	       [Name])			-- names bound by this evaluation

ghc/compiler/deSugar/DsExpr.lhs

@@ -511,7 +511,7 @@ dsDo do_or_lc stmts return_id then_id fail_id result_ty
 			DoExpr   -> True
 			ListComp -> False
 	
-	-- For ExprStmt, see the comments near HsExpr.HsStmt about 
+	-- For ExprStmt, see the comments near HsExpr.Stmt about 
 	-- exactly what ExprStmts mean!
 	--
 	-- In dsDo we can only see DoStmt and ListComp (no gaurds)

ghc/compiler/deSugar/DsGRHSs.lhs

@@ -74,7 +74,7 @@ matchGuard :: [TypecheckedStmt] 	-- Guard
            -> DsMatchContext            -- Context
 	   -> DsM MatchResult
 
--- See comments with HsExpr.HsStmt re what an ExprStmt means
+-- See comments with HsExpr.Stmt re what an ExprStmt means
 -- Here we must be in a guard context (not do-expression, nor list-comp)	
 
 matchGuard [ResultStmt expr locn] ctx 

ghc/compiler/ghci/InteractiveUI.hs

 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.81 2001/07/17 14:53:48 rrt Exp $
+-- $Id: InteractiveUI.hs,v 1.82 2001/07/18 16:06:10 rrt Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -16,6 +16,7 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 import Packages
 import CompManager
 import HscTypes		( GhciMode(..) )
+import MkIface          ( ifaceTyCls )
 import ByteCodeLink
 import DriverFlags
 import DriverState
@@ -71,6 +72,7 @@ builtin_commands = [
   ("def",	keepGoing defineMacro),
   ("help",	keepGoing help),
   ("?",		keepGoing help),
+  ("info",      keepGoing info),
   ("load",	keepGoing loadModule),
   ("module",	keepGoing setContext),
   ("reload",	keepGoing reloadModule),
@@ -88,12 +90,14 @@ shortHelpText = "use :? for help.\n"
 
 helpText = "\ 
 \ Commands available from the prompt:\n\ 
-\\  
+\\
 \   <stmt>		   evaluate/run <stmt>\n\ 
 \   :add <filename> ...    add module(s) to the current target set\n\ 
 \   :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\ 
 \   :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\ 
@@ -200,11 +204,10 @@ runGHCi = do
 -- and aren't world writable.  Otherwise, we could be accidentally 
 -- running code planted by a malicious third party.
 
--- Furthermore, We only read ./.ghci if both . and ./.ghci are
--- owned by the current user and aren't writable by anyone else.  I
--- think this is sufficient: we don't need to check .. and
--- ../.. etc. because "."  always refers to the same directory while a
--- process is running.
+-- Furthermore, We only read ./.ghci if . is owned by the current user
+-- and isn't writable by anyone else.  I think this is sufficient: we
+-- don't need to check .. and ../.. etc. because "."  always refers to
+-- the same directory while a process is running.
 
 checkPerms :: String -> IO Bool
 checkPerms name =
@@ -364,6 +367,19 @@ noArgs c = throwDyn (CmdLineError ("command `" ++ c ++ "' takes no arguments"))
 help :: String -> GHCi ()
 help _ = io (putStr helpText)
 
+info :: String -> GHCi ()
+info "" = do io (putStr "dunno, mate")
+info s = do
+  let names = words s
+  st <- getGHCiState
+  let cmst = cmstate st
+  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)
+
 addModule :: String -> GHCi ()
 addModule str = do
   let files = words str
@@ -643,7 +659,8 @@ unsetOption opt
  = do st <- getGHCiState
       setGHCiState (st{ options = filter (/= opt) (options st) })
 
-io m = GHCi $ \s -> m >>= \a -> return a
+io :: IO a -> GHCi a
+io m = GHCi { unGHCi = \s -> m >>= return }
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers

ghc/compiler/main/HscMain.lhs

@@ -7,7 +7,7 @@
 \begin{code}
 module HscMain ( HscResult(..), hscMain, 
 #ifdef GHCI
-		 hscStmt,
+		 hscStmt, hscThing,
 #endif
 		 initPersistentCompilerState ) where
 
@@ -17,14 +17,18 @@ module HscMain ( HscResult(..), hscMain,
 import ByteCodeGen	( byteCodeGen )
 import CoreTidy		( tidyCoreExpr )
 import CorePrep		( corePrepExpr )
+import SrcLoc           ( noSrcLoc )
 import Rename		( renameStmt )
+import RdrName          ( mkUnqual )
 import RdrHsSyn		( RdrNameStmt )
+import OccName          ( dataName )
 import Type		( Type )
 import Id		( Id, idName, setGlobalIdDetails )
 import IdInfo		( GlobalIdDetails(VanillaGlobal) )
 import HscTypes		( InteractiveContext(..) )
 import PrelNames	( iNTERACTIVE )
 import StringBuffer	( stringToStringBuffer )
+import FastString       ( mkFastString )
 #endif
 
 import HsSyn
@@ -551,6 +555,31 @@ hscStmt dflags hst hit pcs0 icontext stmt just_expr
 
      }}}}}
 
+hscThing -- like hscStmt, but deals with a single identifier
+  :: DynFlags
+  -> HomeSymbolTable	
+  -> HomeIfaceTable
+  -> PersistentCompilerState    -- IN: persistent compiler state
+  -> InteractiveContext		-- Context for compiling
+  -> String			-- The identifier
+  -> IO ( PersistentCompilerState, 
+	  Maybe TyThing )
+hscThing dflags hst hit pcs0 icontext id
+   = let 
+	InteractiveContext { 
+	     ic_rn_env   = rn_env, 
+	     ic_type_env = type_env,
+	     ic_module   = scope_mod } = icontext
+	fname = mkFastString id
+	rn = mkUnqual dataName fname -- need to guess correct namespace
+	stmt = ResultStmt (HsVar rn) noSrcLoc
+     in
+     do { (pcs, err, maybe_stmt) <- renameStmt dflags hit hst pcs0 scope_mod scope_mod rn_env stmt
+	; case maybe_stmt of
+	     Nothing -> return (pcs, Nothing)
+	     Just (n:ns, _) -> return (pcs, lookupType hst type_env n)
+	}
+
 hscParseStmt :: DynFlags -> String -> IO (Maybe RdrNameStmt)
 hscParseStmt dflags str
  = do --------------------------  Parser  ----------------

ghc/compiler/main/MkIface.lhs

@@ -7,7 +7,8 @@
 \begin{code}
 module MkIface ( 
 	mkFinalIface,
-	pprModDetails, pprIface, pprUsage
+	pprModDetails, pprIface, pprUsage,
+	ifaceTyCls,
   ) where
 
 #include "HsVersions.h"

ghc/compiler/parser/ParseUtil.lhs

@@ -20,7 +20,7 @@ module ParseUtil (
 	, checkSimple		-- HsType -> [HsName] -> P ((HsName,[HsName]))
 	, checkPattern		-- HsExp -> P HsPat
 	, checkPatterns		-- SrcLoc -> [HsExp] -> P [HsPat]
-	, checkDo		-- [HsStmt] -> P [HsStmt]
+	, checkDo		-- [Stmt] -> P [Stmt]
 	, checkValDef		-- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
 	, checkValSig		-- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
  ) where