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

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 3f91af6..4e00c61 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -29,6 +29,12 @@ module GHC (
        removeTarget,
        guessTarget,
        
        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
        -- * 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(..),
                          tcRnLookupName, getModuleExports )
 import RdrName         ( plusGlobalRdrEnv, Provenance(..), 
                          ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),

-                         emptyGlobalRdrEnv, mkGlobalRdrEnv )
+                         mkGlobalRdrEnv )

 import HscMain         ( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
 import Type            ( tidyType )
 import VarEnv          ( emptyTidyEnv )
 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(..), 
 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,
 import HsSyn
 import Type            ( Kind, Type, dropForAlls, PredType, ThetaType,
                          pprThetaArrow, pprParendType, splitForAllTys,

@@ -447,6 +454,31 @@ guessTarget file Nothing
         lhs_file = file `joinFileExt` "lhs"
 
 -- -----------------------------------------------------------------------------
         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
 
 -- Perform a dependency analysis starting from the current targets
 -- Loading the program
 
 -- Perform a dependency analysis starting from the current targets

diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index e170f8f..986d2ce 100644 (file)
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -47,7 +47,7 @@ import VarEnv         ( emptyTidyEnv )
 
 import Var             ( Id )
 import Module          ( emptyModuleEnv, ModLocation(..) )
 
 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 )
 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 CodeGen         ( codeGen )
 import CmmParse                ( parseCmmFile )
 import CodeOutput      ( codeOutput )

+import NameEnv          ( emptyNameEnv )

 
 import DynFlags
 import ErrUtils
 
 import DynFlags
 import ErrUtils

@@ -114,7 +115,9 @@ newHscEnv dflags
                           hsc_HPT    = emptyHomePackageTable,
                           hsc_EPS    = eps_var,
                           hsc_NC     = nc_var,
                           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,
                        
 
 knownKeyNames :: [Name]        -- Put here to avoid loops involving DsMeta,

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index ee5438b..c46d78e 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -172,9 +172,11 @@ data HscEnv
                -- sucking in interface files.  They cache the state of
                -- external interface files, in effect.
 
                -- 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.
                -- 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
  }
 
 hscEPS :: HscEnv -> IO ExternalPackageState

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 5f4b487..347d38b 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/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 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
 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 -> 
 
                -- 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
                      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

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index ff1979b..4fa3d8d 100644 (file)
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/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,
             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_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,
                tcg_type_env_var = type_env_var,
                tcg_inst_env  = emptyInstEnv,
                tcg_inst_uses = dfuns_var,