X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FGHC.hs;h=92345c73145f83c29de1ce5c494ef9c9409d8ba2;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hp=64042e2c31ec129d6aca0cd5ceccedc42271aba7;hpb=8b6c1605e75a2482892995c6d0529911796e89dd;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 64042e2..92345c7 100644
--- 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
 
@@ -148,7 +148,7 @@ module GHC (
 	TyCon, 
 	tyConTyVars, tyConDataCons, tyConArity,
 	isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
-	isOpenTyCon,
+	isFamilyTyCon,
 	synTyConDefn, synTyConType, synTyConResKind,
 
 	-- ** Type variables
@@ -243,11 +243,11 @@ import Linker           ( HValue )
 import ByteCodeInstr
 import BreakArray
 import InteractiveEval
-import TcRnDriver
 #endif
 
+import TcRnDriver
 import TcIface
-import TcRnTypes        hiding (LIE)
+import TcRnTypes
 import TcRnMonad        ( initIfaceCheck )
 import Packages
 import NameSet
@@ -255,6 +255,7 @@ import RdrName
 import qualified HsSyn -- hack as we want to reexport the whole module
 import HsSyn hiding ((<.>))
 import Type
+import Coercion		( synTyConResKind )
 import TcType		hiding( typeKind )
 import Id
 import Var
@@ -334,6 +335,7 @@ defaultErrorHandler dflags inner =
                 Just (ioe :: IOException) ->
                   fatalErrorMsg dflags (text (show ioe))
                 _ -> case fromException exception of
+		     Just UserInterrupt -> exitWith (ExitFailure 1)
                      Just StackOverflow ->
                          fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
                      _ -> case fromException exception of
@@ -350,7 +352,6 @@ defaultErrorHandler dflags inner =
   		hFlush stdout
   		case ge of
 		     PhaseFailed _ code -> exitWith code
-		     Interrupted -> exitWith (ExitFailure 1)
 		     Signal _ -> exitWith (ExitFailure 1)
 		     _ -> do fatalErrorMsg dflags (text (show ge))
 			     exitWith (ExitFailure 1)
@@ -2016,7 +2017,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 +2436,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 +2724,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?
+