Commit 3e392c96 authored by simonmar's avatar simonmar
Browse files

[project @ 2005-04-08 14:51:48 by simonmar]

GHC API work:

  - add parseName :: Session -> String -> IO [Name]
  - make lookupName look up in the global type environment

  - add data ModuleInfo
  - add a few ModuleInfo-related functions
  - add getModuleInfo :: Session -> Module -> IO ModuleInfo
parent 2f967bd6
......@@ -42,6 +42,13 @@ module GHC (
isLoaded,
topSortModuleGraph,
-- * Inspecting modules
ModuleInfo,
getModuleInfo,
modInfoTyThings,
modInfoInstances,
lookupName,
-- * Interactive evaluation
getBindings, getPrintUnqual,
#ifdef GHCI
......@@ -50,7 +57,7 @@ module GHC (
getInfo, GetInfoResult,
exprType,
typeKind,
lookupName,
parseName,
RunResult(..),
runStmt,
browseModule,
......@@ -76,6 +83,9 @@ module GHC (
-- ** Classes
Class,
-- ** Instances
Instance,
-- ** Types and Kinds
Type, dropForAlls,
Kind,
......@@ -109,9 +119,9 @@ module GHC (
import qualified Linker
import Linker ( HValue, extendLinkEnv )
import NameEnv ( lookupNameEnv )
import TcRnDriver ( mkExportEnv, getModuleContents )
import TcRnDriver ( mkExportEnv, getModuleContents, tcRnLookupRdrName )
import RdrName ( plusGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult,
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
......@@ -130,7 +140,7 @@ import DataCon ( DataCon )
import Name ( Name )
import RdrName ( RdrName )
import NameEnv ( nameEnvElts )
import SrcLoc ( Located )
import SrcLoc ( Located(..) )
import DriverPipeline
import DriverPhases ( Phase(..), isHaskellSrcFilename, startPhase )
import GetImports ( getImports )
......@@ -1427,22 +1437,65 @@ getBindings s = withSession s (return . nameEnvElts . ic_type_env . hsc_IC)
getPrintUnqual :: Session -> IO PrintUnqualified
getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
#ifdef GHCI
-- | Parses a string as an identifier, and returns the list of 'Name's that
-- the identifier can refer to in the current interactive context.
parseName :: Session -> String -> IO [Name]
parseName s str = withSession s $ \hsc_env -> do
maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
case maybe_rdr_name of
Nothing -> return []
Just (L _ rdr_name) -> do
mb_names <- tcRnLookupRdrName hsc_env rdr_name
case mb_names of
Nothing -> return []
Just ns -> return ns
-- ToDo: should return error messages
#endif
-- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
-- entity known to GHC, including 'Name's defined using 'runStmt'.
lookupName :: Session -> Name -> IO (Maybe TyThing)
lookupName s name = withSession s $ \hsc_env -> do
case lookupTypeEnv (ic_type_env (hsc_IC hsc_env)) name of
Just tt -> return (Just tt)
Nothing -> do
eps <- readIORef (hsc_EPS hsc_env)
return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
-- | Container for information about a 'Module'.
newtype ModuleInfo = ModuleInfo ModDetails
-- ToDo: this should really contain the ModIface too
-- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too.
-- | Request information about a loaded 'Module'
getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
getModuleInfo s mdl = withSession s $ \hsc_env -> do
case lookupModuleEnv (hsc_HPT hsc_env) mdl of
Nothing -> return Nothing
Just hmi -> return (Just (ModuleInfo (hm_details hmi)))
-- ToDo: we should be able to call getModuleInfo on a package module,
-- even one that isn't loaded yet.
-- | The list of top-level entities defined in a module
modInfoTyThings :: ModuleInfo -> [TyThing]
modInfoTyThings (ModuleInfo md) = typeEnvElts (md_types md)
-- | An instance of a class
newtype Instance = Instance DFunId
-- | The list of 'Instance's defined in a module
modInfoInstances :: ModuleInfo -> [Instance]
modInfoInstances (ModuleInfo md) = map Instance (md_insts md)
#if 0
getModuleInfo :: Session -> Module -> IO ModuleInfo
data ObjectCode
= ByteCode
| BinaryCode FilePath
data ModuleInfo = ModuleInfo {
lm_modulename :: Module,
lm_summary :: ModSummary,
lm_interface :: ModIface,
lm_tc_code :: Maybe TypecheckedCode,
lm_rn_code :: Maybe RenamedCode,
lm_obj :: Maybe ObjectCode
}
type TypecheckedCode = HsTypecheckedGroup
type RenamedCode = [HsGroup Name]
......@@ -1560,6 +1613,7 @@ moduleIsInterpreted s modl = withSession s $ \h ->
_not_a_home_module -> return False
-- | Looks up an identifier in the current interactive context (for :info)
{-# DEPRECATED getInfo "we should be using parseName/lookupName instead" #-}
getInfo :: Session -> String -> IO [GetInfoResult]
getInfo s id = withSession s $ \hsc_env -> hscGetInfo hsc_env id
......@@ -1588,14 +1642,6 @@ typeKind s str = withSession s $ \hsc_env -> do
Nothing -> return Nothing
Just kind -> return (Just kind)
-----------------------------------------------------------------------------
-- lookupName: returns the TyThing for a Name in the interactive context.
-- ToDo: should look it up in the full environment
lookupName :: Session -> Name -> IO (Maybe TyThing)
lookupName s name = withSession s $ \hsc_env -> do
return $! lookupNameEnv (ic_type_env (hsc_IC hsc_env)) name
-----------------------------------------------------------------------------
-- cmCompileExpr: compile an expression and deliver an HValue
......@@ -1696,6 +1742,7 @@ foreign import "rts_evalStableIO" {- safe -}
-- ---------------------------------------------------------------------------
-- cmBrowseModule: get all the TyThings defined in a module
{-# DEPRECATED browseModule "we should be using getModuleInfo instead" #-}
browseModule :: Session -> Module -> Bool -> IO [IfaceDecl]
browseModule s modl exports_only = withSession s $ \hsc_env -> do
mb_decls <- getModuleContents hsc_env modl exports_only
......
......@@ -9,6 +9,7 @@ module HscMain (
HscResult(..),
hscMain, newHscEnv, hscCmmFile,
hscFileCheck,
hscParseIdentifier,
#ifdef GHCI
hscStmt, hscTcExpr, hscKcType,
hscGetInfo, GetInfoResult,
......@@ -19,7 +20,7 @@ module HscMain (
#include "HsVersions.h"
#ifdef GHCI
import HsSyn ( Stmt(..), LStmt, LHsExpr, LHsType )
import HsSyn ( Stmt(..), LHsExpr )
import IfaceSyn ( IfaceDecl, IfaceInst )
import Module ( Module )
import CodeOutput ( outputForeignStubs )
......@@ -33,7 +34,6 @@ import RdrName ( rdrNameOcc )
import OccName ( occNameUserString )
import Type ( Type )
import PrelNames ( iNTERACTIVE )
import StringBuffer ( stringToStringBuffer )
import Kind ( Kind )
import CoreLint ( lintUnfolding )
import DsMeta ( templateHaskellNames )
......@@ -44,9 +44,9 @@ import SrcLoc ( SrcLoc, noSrcLoc )
import Var ( Id )
import Module ( emptyModuleEnv )
import RdrName ( GlobalRdrEnv, RdrName )
import HsSyn ( HsModule, LHsBinds )
import HsSyn ( HsModule, LHsBinds, LStmt, LHsType )
import SrcLoc ( Located(..) )
import StringBuffer ( hGetStringBuffer )
import StringBuffer ( hGetStringBuffer, stringToStringBuffer )
import Parser
import Lexer ( P(..), ParseResult(..), mkPState )
import SrcLoc ( mkSrcLoc )
......@@ -648,6 +648,7 @@ hscKcType hsc_env str
Just other -> do { errorMsg ("not an type: `" ++ str ++ "'") ;
return Nothing } ;
Nothing -> return Nothing } }
#endif
\end{code}
\begin{code}
......@@ -686,7 +687,6 @@ hscParseThing parser dflags str
dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing);
return (Just thing)
}}
#endif
\end{code}
%************************************************************************
......
......@@ -9,6 +9,7 @@ module TcRnDriver (
mkExportEnv, getModuleContents, tcRnStmt,
tcRnGetInfo, GetInfoResult,
tcRnExpr, tcRnType,
tcRnLookupRdrName,
#endif
tcRnModule,
tcTopSrcDecls,
......@@ -757,7 +758,6 @@ check_main ghci_mode tcg_env main_mod main_fn
<+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
\end{code}
%*********************************************************
%* *
GHCi stuff
......@@ -1129,22 +1129,15 @@ type GetInfoResult = (String, IfaceDecl, Fixity, SrcLoc,
[(IfaceType,SrcLoc)] -- Instances
)
tcRnGetInfo :: HscEnv
-> InteractiveContext
-> RdrName
-> IO (Maybe [GetInfoResult])
tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
-- Used to implemnent :info in GHCi
--
-- Look up a RdrName and return all the TyThings it might be
-- A capitalised RdrName is given to us in the DataName namespace,
-- but we want to treat it as *both* a data constructor
-- *and* as a type or class constructor;
-- hence the call to dataTcOccs, and we return up to two results
tcRnGetInfo hsc_env ictxt rdr_name
tcRnLookupRdrName hsc_env rdr_name
= initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext hsc_env ictxt $ do {
setInteractiveContext hsc_env (hsc_IC hsc_env) $
lookup_rdr_name rdr_name
lookup_rdr_name rdr_name = do {
-- If the identifier is a constructor (begins with an
-- upper-case letter), then we need to consider both
-- constructor and type class identifiers.
......@@ -1169,7 +1162,29 @@ tcRnGetInfo hsc_env ictxt rdr_name
do { addMessages (head errs_s) ; failM }
else -- Add deprecation warnings
mapM_ addMessages warns_s ;
return good_names
}
tcRnGetInfo :: HscEnv
-> InteractiveContext
-> RdrName
-> IO (Maybe [GetInfoResult])
-- Used to implemnent :info in GHCi
--
-- Look up a RdrName and return all the TyThings it might be
-- A capitalised RdrName is given to us in the DataName namespace,
-- but we want to treat it as *both* a data constructor
-- *and* as a type or class constructor;
-- hence the call to dataTcOccs, and we return up to two results
tcRnGetInfo hsc_env ictxt rdr_name
= initTcPrintErrors hsc_env iNTERACTIVE $
setInteractiveContext hsc_env ictxt $ do {
good_names <- lookup_rdr_name rdr_name ;
-- And lookup up the entities, avoiding duplicates, which arise
-- because constructors and record selectors are represented by
-- their parent declaration
......
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