Commit 0143969c authored by rrt's avatar rrt
Browse files

[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
parent bdc687a0
......@@ -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
......
......@@ -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)
......
......@@ -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
......
-----------------------------------------------------------------------------
-- $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
......
......@@ -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 ----------------
......
......@@ -7,7 +7,8 @@
\begin{code}
module MkIface (
mkFinalIface,
pprModDetails, pprIface, pprUsage
pprModDetails, pprIface, pprUsage,
ifaceTyCls,
) where
#include "HsVersions.h"
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment