[commit: ghc] master: Add throwGhcExceptionIO and change a few uses of throwGhcException to use it (8d5bc74)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/8d5bc7404664e024b7a845f0597fb4fb1015382b

>---------------------------------------------------------------

commit 8d5bc7404664e024b7a845f0597fb4fb1015382b
Author: Ian Lynagh <ian at well-typed.com>
Date:   Wed Jan 30 00:15:03 2013 +0000

    Add throwGhcExceptionIO and change a few uses of throwGhcException to use it

>---------------------------------------------------------------

 compiler/main/Packages.lhs |   13 +++++++------
 compiler/utils/Panic.lhs   |    7 ++++++-
 2 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 1c04c2c..52361ce 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -230,14 +230,14 @@ readPackageConfig dflags conf_file = do
        else do
             isfile <- doesFileExist conf_file
             when (not isfile) $
-              throwGhcException $ InstallationError $
+              throwGhcExceptionIO $ InstallationError $
                 "can't find a package database at " ++ conf_file
             debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
             str <- readFile conf_file
             case reads str of
                 [(configs, rest)]
                     | all isSpace rest -> return (map installedPackageInfoToPackageConfig configs)
-                _ -> throwGhcException $ InstallationError $
+                _ -> throwGhcExceptionIO $ InstallationError $
                         "invalid package database file " ++ conf_file
 
   let
@@ -410,12 +410,13 @@ packageFlagErr :: DynFlags
 -- for missing DPH package we emit a more helpful error message, because
 -- this may be the result of using -fdph-par or -fdph-seq.
 packageFlagErr dflags (ExposePackage pkg) [] | is_dph_package pkg
-  = throwGhcException (CmdLineError (showSDoc dflags $ dph_err))
+  = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ dph_err))
   where dph_err = text "the " <> text pkg <> text " package is not installed."
                   $$ text "To install it: \"cabal install dph\"."
         is_dph_package pkg = "dph" `isPrefixOf` pkg
 
-packageFlagErr dflags flag reasons = throwGhcException (CmdLineError (showSDoc dflags $ err))
+packageFlagErr dflags flag reasons
+  = throwGhcExceptionIO (CmdLineError (showSDoc dflags $ err))
   where err = text "cannot satisfy " <> ppr_flag <>
                 (if null reasons then empty else text ": ") $$
               nest 4 (ppr_reasons $$
@@ -983,7 +984,7 @@ closeDeps dflags pkg_map ipid_map ps
 throwErr :: DynFlags -> MaybeErr MsgDoc a -> IO a
 throwErr dflags m
               = case m of
-                Failed e    -> throwGhcException (CmdLineError (showSDoc dflags e))
+                Failed e    -> throwGhcExceptionIO (CmdLineError (showSDoc dflags e))
                 Succeeded r -> return r
 
 closeDepsErr :: PackageConfigMap
@@ -1017,7 +1018,7 @@ add_package pkg_db ipid_map ps (p, mb_parent)
 
 missingPackageErr :: DynFlags -> String -> IO a
 missingPackageErr dflags p
-    = throwGhcException (CmdLineError (showSDoc dflags (missingPackageMsg p)))
+    = throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
 
 missingPackageMsg :: String -> SDoc
 missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs
index c02de1c..fc04668 100644
--- a/compiler/utils/Panic.lhs
+++ b/compiler/utils/Panic.lhs
@@ -9,7 +9,9 @@ some unnecessary loops in the module dependency graph.
 
 \begin{code}
 module Panic (
-     GhcException(..), showGhcException, throwGhcException, handleGhcException,
+     GhcException(..), showGhcException,
+     throwGhcException, throwGhcExceptionIO,
+     handleGhcException,
      progName,
      pgmError,
 
@@ -176,6 +178,9 @@ showGhcException exception
 throwGhcException :: GhcException -> a
 throwGhcException = Exception.throw
 
+throwGhcExceptionIO :: GhcException -> IO a
+throwGhcExceptionIO = Exception.throwIO
+
 handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
 handleGhcException = ghandle