Enable -fregs-graph with -O2; fixes #2790

[ghc-hetmet.git] / compiler / main / GHC.hs

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f532061..5dfa76c 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -98,7 +98,7 @@ module GHC (
        typeKind,
        parseName,
        RunResult(..),  
-       runStmt, SingleStep(..),
+       runStmt, parseImportDecl, SingleStep(..),
         resume,
         Resume(resumeStmt, resumeThreadId, resumeBreakInfo, resumeSpan,
                resumeHistory, resumeHistoryIx),
@@ -111,13 +111,13 @@ module GHC (
        showModule,
         isModuleInterpreted,
        InteractiveEval.compileExpr, HValue, dynCompileExpr,
-       lookupName,
         GHC.obtainTermFromId, GHC.obtainTermFromVal, reconstructType,
         modInfoModBreaks,
         ModBreaks(..), BreakIndex,
         BreakInfo(breakInfo_number, breakInfo_module),
         BreakArray, setBreakOn, setBreakOff, getBreak,
 #endif
+        lookupName,
 
        -- * Abstract syntax elements
 
@@ -243,9 +243,9 @@ import Linker           ( HValue )
 import ByteCodeInstr
 import BreakArray
 import InteractiveEval
-import TcRnDriver
 #endif
 
+import TcRnDriver
 import TcIface
 import TcRnTypes        hiding (LIE)
 import TcRnMonad        ( initIfaceCheck )
@@ -2016,7 +2016,10 @@ msDeps s =
         ++ [ (m,False) | m <- ms_home_imps s ] 
 
 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName]
-home_imps imps = [ ideclName i |  L _ i <- imps, isNothing (ideclPkgQual i) ]
+home_imps imps = [ ideclName i |  L _ i <- imps, isLocal (ideclPkgQual i) ]
+  where isLocal Nothing = True
+        isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special
+        isLocal _ = False
 
 ms_home_allimps :: ModSummary -> [ModuleName]
 ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)
@@ -2432,7 +2435,7 @@ getPackageModuleInfo hsc_env mdl = do
        return (Just (ModuleInfo {
                        minf_type_env  = mkTypeEnv tys,
                        minf_exports   = names,
-                       minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names (moduleName mdl),
+                       minf_rdr_env   = Just $! availsToGlobalRdrEnv (moduleName mdl) avails,
                        minf_instances = error "getModuleInfo: instances for package module unimplemented",
                         minf_modBreaks = emptyModBreaks  
                }))
@@ -2720,3 +2723,12 @@ obtainTermFromId bound force id =
       liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
 
 #endif
+
+-- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
+-- entity known to GHC, including 'Name's defined using 'runStmt'.
+lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
+lookupName name = withSession $ \hsc_env -> do
+  mb_tything <- ioMsg $ tcRnLookupName hsc_env name
+  return mb_tything
+  -- XXX: calls panic in some circumstances;  is that ok?
+