Commit 0a1b7cb8 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Change a few throwGhcException uses to throwGhcExceptionIO

parent 1bb4913c
......@@ -96,7 +96,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
errorOnMismatch what wanted got =
-- This will be caught by readIface which will emit an error
-- msg containing the iface module name.
when (wanted /= got) $ throwGhcException $ ProgramError
when (wanted /= got) $ throwGhcExceptionIO $ ProgramError
(what ++ " (wanted " ++ show wanted
++ ", got " ++ show got ++ ")")
bh <- Binary.readBinMem hi_path
......
......@@ -172,7 +172,7 @@ loadInterfaceWithException doc mod_name where_from
= do { mb_iface <- loadInterface doc mod_name where_from
; dflags <- getDynFlags
; case mb_iface of
Failed err -> throwGhcException (ProgramError (showSDoc dflags err))
Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err))
Succeeded iface -> return iface }
------------------
......
......@@ -829,7 +829,7 @@ oldMD5 dflags bh = do
let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
r <- system cmd
case r of
ExitFailure _ -> throwGhcException (PhaseFailed cmd r)
ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r)
ExitSuccess -> do
hash_str <- readFile tmp2
return $! readHexFingerprint hash_str
......
......@@ -64,8 +64,8 @@ doMkDependHS srcs = do
}
_ <- GHC.setSessionDynFlags dflags
when (null (depSuffixes dflags)) $
throwGhcException (ProgramError "You must specify at least one -dep-suffix")
when (null (depSuffixes dflags)) $ liftIO $
throwGhcExceptionIO (ProgramError "You must specify at least one -dep-suffix")
files <- liftIO $ beginMkDependHS dflags
......@@ -193,7 +193,7 @@ processDeps :: DynFlags
processDeps dflags _ _ _ _ (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
throwGhcException (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes))
throwGhcExceptionIO (ProgramError (showSDoc dflags $ GHC.cyclicModuleErr nodes))
processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC node)
= do { let extra_suffixes = depSuffixes dflags
......
......@@ -1425,7 +1425,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time))
| otherwise = False
when needs_preprocessing $
throwGhcException (ProgramError "buffer needs preprocesing; interactive check disabled")
throwGhcExceptionIO (ProgramError "buffer needs preprocesing; interactive check disabled")
return (dflags', src_fn, buf)
......
......@@ -353,7 +353,7 @@ findTopDir Nothing
maybe_exec_dir <- getBaseDir
case maybe_exec_dir of
-- "Just" on Windows, "Nothing" on unix
Nothing -> throwGhcException (InstallationError "missing -B<dir> option")
Nothing -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
Just dir -> return dir
\end{code}
......@@ -837,14 +837,14 @@ handleProc pgm phase_name proc = do
-- the case of a missing program there will otherwise be no output
-- at all.
| n == 127 -> does_not_exist
| otherwise -> throwGhcException (PhaseFailed phase_name rc)
| otherwise -> throwGhcExceptionIO (PhaseFailed phase_name rc)
where
handler err =
if IO.isDoesNotExistError err
then does_not_exist
else IO.ioError err
does_not_exist = throwGhcException (InstallationError ("could not execute: " ++ pgm))
does_not_exist = throwGhcExceptionIO (InstallationError ("could not execute: " ++ pgm))
builderMainLoop :: DynFlags -> (String -> String) -> FilePath
......@@ -976,7 +976,7 @@ traceCmd dflags phase_name cmd_line action
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
; throwGhcException (PhaseFailed phase_name (ExitFailure 1)) }
; throwGhcExceptionIO (PhaseFailed phase_name (ExitFailure 1)) }
\end{code}
%************************************************************************
......
......@@ -334,7 +334,8 @@ loadPlugin hsc_env mod_name
dflags = hsc_dflags hsc_env
; mb_name <- lookupRdrNameInModule hsc_env mod_name plugin_rdr_name
; case mb_name of {
Nothing -> throwGhcException (CmdLineError $ showSDoc dflags $ hsep
Nothing ->
throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
[ ptext (sLit "The module"), ppr mod_name
, ptext (sLit "did not export the plugin name")
, ppr plugin_rdr_name ]) ;
......@@ -343,7 +344,8 @@ loadPlugin hsc_env mod_name
do { plugin_tycon <- forceLoadTyCon hsc_env pluginTyConName
; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
; case mb_plugin of
Nothing -> throwGhcException (CmdLineError $ showSDoc dflags $ hsep
Nothing ->
throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
[ ptext (sLit "The value"), ppr name
, ptext (sLit "did not have the type")
, ppr pluginTyConName, ptext (sLit "as required")])
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment