Commit 2c1ea2ce authored by David Himmelstrup's avatar David Himmelstrup

Make the initial rdr and type scope available in the ghc-api.

parent 10cc302b
......@@ -29,6 +29,12 @@ module GHC (
removeTarget,
guessTarget,
-- * Extending the program scope
extendGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
setGlobalRdrScope, -- :: Session -> [GlobalRdrElt] -> IO ()
extendGlobalTypeScope, -- :: Session -> [Id] -> IO ()
setGlobalTypeScope, -- :: Session -> [Id] -> IO ()
-- * Loading\/compiling the program
depanal,
load, LoadHowMuch(..), SuccessFlag(..), -- also does depanal
......@@ -169,7 +175,7 @@ import TcRnDriver ( tcRnLookupRdrName, tcRnGetInfo,
tcRnLookupName, getModuleExports )
import RdrName ( plusGlobalRdrEnv, Provenance(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
emptyGlobalRdrEnv, mkGlobalRdrEnv )
mkGlobalRdrEnv )
import HscMain ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
......@@ -179,7 +185,8 @@ import GHC.Exts ( unsafeCoerce# )
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList, elemNameSet )
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..),
globalRdrEnvElts )
globalRdrEnvElts, extendGlobalRdrEnv,
emptyGlobalRdrEnv )
import HsSyn
import Type ( Kind, Type, dropForAlls, PredType, ThetaType,
pprThetaArrow, pprParendType, splitForAllTys,
......@@ -446,6 +453,31 @@ guessTarget file Nothing
hs_file = file `joinFileExt` "hs"
lhs_file = file `joinFileExt` "lhs"
-- -----------------------------------------------------------------------------
-- Extending the program scope
extendGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
extendGlobalRdrScope session rdrElts
= modifySession session $ \hscEnv ->
let global_rdr = hsc_global_rdr_env hscEnv
in hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv global_rdr rdrElts }
setGlobalRdrScope :: Session -> [GlobalRdrElt] -> IO ()
setGlobalRdrScope session rdrElts
= modifySession session $ \hscEnv ->
hscEnv{ hsc_global_rdr_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv rdrElts }
extendGlobalTypeScope :: Session -> [Id] -> IO ()
extendGlobalTypeScope session ids
= modifySession session $ \hscEnv ->
let global_type = hsc_global_type_env hscEnv
in hscEnv{ hsc_global_type_env = extendTypeEnvWithIds global_type ids }
setGlobalTypeScope :: Session -> [Id] -> IO ()
setGlobalTypeScope session ids
= modifySession session $ \hscEnv ->
hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
-- -----------------------------------------------------------------------------
-- Loading the program
......
......@@ -47,7 +47,7 @@ import VarEnv ( emptyTidyEnv )
import Var ( Id )
import Module ( emptyModuleEnv, ModLocation(..) )
import RdrName ( GlobalRdrEnv, RdrName )
import RdrName ( GlobalRdrEnv, RdrName, emptyGlobalRdrEnv )
import HsSyn ( HsModule, LHsBinds, HsGroup, LIE, LImportDecl )
import SrcLoc ( Located(..) )
import StringBuffer ( hGetStringBuffer, stringToStringBuffer )
......@@ -74,6 +74,7 @@ import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import CmmParse ( parseCmmFile )
import CodeOutput ( codeOutput )
import NameEnv ( emptyNameEnv )
import DynFlags
import ErrUtils
......@@ -114,7 +115,9 @@ newHscEnv dflags
hsc_HPT = emptyHomePackageTable,
hsc_EPS = eps_var,
hsc_NC = nc_var,
hsc_FC = fc_var } ) }
hsc_FC = fc_var,
hsc_global_rdr_env = emptyGlobalRdrEnv,
hsc_global_type_env = emptyNameEnv } ) }
knownKeyNames :: [Name] -- Put here to avoid loops involving DsMeta,
......
......@@ -172,9 +172,11 @@ data HscEnv
-- sucking in interface files. They cache the state of
-- external interface files, in effect.
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache)
hsc_FC :: {-# UNPACK #-} !(IORef FinderCache),
-- The finder's cache. This caches the location of modules,
-- so we don't have to search the filesystem multiple times.
hsc_global_rdr_env :: GlobalRdrEnv,
hsc_global_type_env :: TypeEnv
}
hscEPS :: HscEnv -> IO ExternalPackageState
......
......@@ -64,7 +64,7 @@ import ErrUtils ( Messages, mkDumpDoc, showPass )
import Id ( Id, mkExportedLocalId, isLocalId, idName, idType )
import Var ( Var )
import Module ( Module, ModuleEnv, moduleEnvElts, elemModuleEnv )
import OccName ( mkVarOccFS )
import OccName ( mkVarOccFS, plusOccEnv )
import Name ( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName,
mkExternalName, isInternalName )
import NameSet
......@@ -188,7 +188,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax
-- Update the gbl env
updGblEnv ( \ gbl ->
gbl { tcg_rdr_env = rdr_env,
gbl { tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env,
tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
tcg_imports = tcg_imports gbl `plusImportAvails` imports,
tcg_rn_imports = if save_rn_syntax then
......
......@@ -96,10 +96,10 @@ initTc hsc_env hsc_src mod do_this
gbl_env = TcGblEnv {
tcg_mod = mod,
tcg_src = hsc_src,
tcg_rdr_env = emptyGlobalRdrEnv,
tcg_rdr_env = hsc_global_rdr_env hsc_env,
tcg_fix_env = emptyNameEnv,
tcg_default = Nothing,
tcg_type_env = emptyNameEnv,
tcg_type_env = hsc_global_type_env hsc_env,
tcg_type_env_var = type_env_var,
tcg_inst_env = emptyInstEnv,
tcg_inst_uses = dfuns_var,
......
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