Use UserInterrupt rather than our own Interrupted exception (#4100)

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

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index e402d89..f532061 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -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
@@ -335,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
@@ -351,7 +351,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)
@@ -2533,7 +2532,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