[commit: ghc] master: Use throwIO rather than throw (e40299c)
Ian Lynagh
igloo at earth.li
Thu Jan 31 01:29:54 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/e40299c36c48a41e97f05d7be17042034fd24007
>---------------------------------------------------------------
commit e40299c36c48a41e97f05d7be17042034fd24007
Author: Ian Lynagh <ian at well-typed.com>
Date: Wed Jan 30 16:37:54 2013 +0000
Use throwIO rather than throw
>---------------------------------------------------------------
compiler/main/ErrUtils.lhs | 3 ++-
compiler/main/GHC.hs | 12 ++++++------
compiler/main/SysTools.lhs | 2 +-
compiler/utils/Exception.hs | 2 +-
ghc/InteractiveUI.hs | 2 +-
5 files changed, 11 insertions(+), 10 deletions(-)
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs
index e0d6a96..3fd92ed 100644
--- a/compiler/main/ErrUtils.lhs
+++ b/compiler/main/ErrUtils.lhs
@@ -52,6 +52,7 @@ import Data.IORef
import Data.Ord
import Data.Time
import Control.Monad
+import Control.Monad.IO.Class
import System.IO
-- -----------------------------------------------------------------------------
@@ -360,6 +361,6 @@ prettyPrintGhcErrors dflags
PprProgramError str doc ->
pprDebugAndThen dflags pgmError str doc
_ ->
- throw e
+ liftIO $ throwIO e
\end{code}
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 5db2de4..ee40a13 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -348,7 +348,7 @@ defaultErrorHandler fm (FlushOut flushOut) inner =
Just StackOverflow ->
fatalErrorMsg'' fm "stack overflow: use +RTS -K<size> to increase it"
_ -> case fromException exception of
- Just (ex :: ExitCode) -> throw ex
+ Just (ex :: ExitCode) -> liftIO $ throwIO ex
_ ->
fatalErrorMsg'' fm
(show (Panic (show exception)))
@@ -748,10 +748,10 @@ getModSummary mod = do
mg <- liftM hsc_mod_graph getSession
case [ ms | ms <- mg, ms_mod_name ms == mod, not (isBootSummary ms) ] of
[] -> do dflags <- getDynFlags
- throw $ mkApiErr dflags (text "Module not part of module graph")
+ liftIO $ throwIO $ mkApiErr dflags (text "Module not part of module graph")
[ms] -> return ms
multiple -> do dflags <- getDynFlags
- throw $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
+ liftIO $ throwIO $ mkApiErr dflags (text "getModSummary is ambiguous: " <+> ppr multiple)
-- | Parse a module.
--
@@ -1213,7 +1213,7 @@ getModuleSourceAndFlags mod = do
m <- getModSummary (moduleName mod)
case ml_hs_file $ ms_location m of
Nothing -> do dflags <- getDynFlags
- throw $ mkApiErr dflags (text "No source available for module " <+> ppr mod)
+ liftIO $ throwIO $ mkApiErr dflags (text "No source available for module " <+> ppr mod)
Just sourceFile -> do
source <- liftIO $ hGetStringBuffer sourceFile
return (sourceFile, source, ms_hspp_opts m)
@@ -1231,7 +1231,7 @@ getTokenStream mod = do
POk _ ts -> return ts
PFailed span err ->
do dflags <- getDynFlags
- throw $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
+ liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
-- | Give even more information on the source than 'getTokenStream'
-- This function allows reconstructing the source completely with
@@ -1244,7 +1244,7 @@ getRichTokenStream mod = do
POk _ ts -> return $ addSourceToTokens startLoc source ts
PFailed span err ->
do dflags <- getDynFlags
- throw $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
+ liftIO $ throwIO $ mkSrcErr (unitBag $ mkPlainErrMsg dflags span err)
-- | Given a source location and a StringBuffer corresponding to this
-- location, return a rich token stream with the source associated to the
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index e648481..40a7a25 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -540,7 +540,7 @@ runClang dflags args = do
text ("Error running clang! you need clang installed to use the" ++
"LLVM backend") $+$
text "(or GHC tried to execute clang incorrectly)"
- throw err
+ throwIO err
)
-- | Figure out which version of LLVM we are running this session
diff --git a/compiler/utils/Exception.hs b/compiler/utils/Exception.hs
index 9d196fd..b490899 100644
--- a/compiler/utils/Exception.hs
+++ b/compiler/utils/Exception.hs
@@ -93,5 +93,5 @@ ghandle = flip gcatch
gonException :: (ExceptionMonad m) => m a -> m b -> m a
gonException ioA cleanup = ioA `gcatch` \e ->
do _ <- cleanup
- throw (e :: SomeException)
+ liftIO $ throwIO (e :: SomeException)
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index bc85b45..c5d2808 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -833,7 +833,7 @@ runStmt stmt step
-- | Clean up the GHCi environment after a statement has run
afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool
-afterRunStmt _ (GHC.RunException e) = throw e
+afterRunStmt _ (GHC.RunException e) = liftIO $ Exception.throwIO e
afterRunStmt step_here run_result = do
resumes <- GHC.getResumeContext
case run_result of
More information about the ghc-commits
mailing list