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

compiler/main/GHC.hs

@@ -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
 

compiler/main/HscMain.lhs

@@ -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,

compiler/main/HscTypes.lhs

@@ -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

compiler/typecheck/TcRnDriver.lhs

@@ -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

compiler/typecheck/TcRnMonad.lhs

@@ -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,