X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=ae2dedfed37f097bf7c109d7d7ca3adf385cc454;hb=c9bb6b63aa1f479a3dd3679c7e4c2c69471a4912;hp=f8a4dbb37643cd9fd3e98818b40199c9eb2ec453;hpb=ce426964baf58f76ad4681d8a26f671c10ad4f7e;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index f8a4dbb..ae2dedf 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),
@@ -158,7 +158,7 @@ module GHC (
 	-- ** Data constructors
 	DataCon,
 	dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
-	dataConIsInfix, isVanillaDataCon,
+	dataConIsInfix, isVanillaDataCon, dataConUserType,
 	dataConStrictMarks,  
 	StrictnessMark(..), isMarkedStrict,
 
@@ -176,7 +176,7 @@ module GHC (
 	pprParendType, pprTypeApp, 
 	Kind,
 	PredType,
-	ThetaType, pprThetaArrow,
+	ThetaType, pprForAll, pprThetaArrow,
 
 	-- ** Entities
 	TyThing(..), 
@@ -284,8 +284,7 @@ import SysTools     ( initSysTools, cleanTempFiles, cleanTempFilesExcept,
                       cleanTempDirs )
 import Annotations
 import Module
-import LazyUniqFM
-import qualified UniqFM as UFM
+import UniqFM
 import FiniteMap
 import Panic
 import Digraph
@@ -300,7 +299,6 @@ import Maybes		( expectJust, mapCatMaybes )
 import FastString
 import Lexer
 
-import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist,
                           getCurrentDirectory )
 import Data.Maybe
@@ -336,6 +334,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
@@ -352,7 +351,7 @@ 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)
 	    ) $
@@ -454,8 +453,6 @@ runGhcT mb_top_dir ghct = do
 initGhcMonad :: GhcMonad m => Maybe FilePath -> m ()
 initGhcMonad mb_top_dir = do
   -- catch ^C
-  main_thread <- liftIO $ myThreadId
-  liftIO $ modifyMVar_ interruptTargetThread (return . (main_thread :))
   liftIO $ installSignalHandlers
 
   liftIO $ StaticFlags.initStaticOpts
@@ -2019,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)
@@ -2435,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  
 		}))
@@ -2535,7 +2535,7 @@ packageDbModules :: GhcMonad m =>
                  -> m [Module]
 packageDbModules only_exposed = do
    dflags <- getSessionDynFlags
-   let pkgs = UFM.eltsUFM (pkgIdMap (pkgState dflags))
+   let pkgs = eltsUFM (pkgIdMap (pkgState dflags))
    return $
      [ mkModule pid modname | p <- pkgs
                             , not only_exposed || exposed p