Commit aa9a4f10 authored by Ian Lynagh's avatar Ian Lynagh

Follow extensible exception changes

parent 179a3a7b
......@@ -1141,12 +1141,12 @@ realWorldName = mkWiredInIdName gHC_PRIM (fsLit "realWorld#") realWorldPri
lazyIdName = mkWiredInIdName gHC_BASE (fsLit "lazy") lazyIdKey lazyId
errorName = mkWiredInIdName gHC_ERR (fsLit "error") errorIdKey eRROR_ID
recSelErrorName = mkWiredInIdName gHC_ERR (fsLit "recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID
runtimeErrorName = mkWiredInIdName gHC_ERR (fsLit "runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID
irrefutPatErrorName = mkWiredInIdName gHC_ERR (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
recConErrorName = mkWiredInIdName gHC_ERR (fsLit "recConError") recConErrorIdKey rEC_CON_ERROR_ID
patErrorName = mkWiredInIdName gHC_ERR (fsLit "patError") patErrorIdKey pAT_ERROR_ID
noMethodBindingErrorName = mkWiredInIdName gHC_ERR (fsLit "noMethodBindingError")
recSelErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recSelError") recSelErrorIdKey rEC_SEL_ERROR_ID
runtimeErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "runtimeError") runtimeErrorIdKey rUNTIME_ERROR_ID
irrefutPatErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
recConErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "recConError") recConErrorIdKey rEC_CON_ERROR_ID
patErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "patError") patErrorIdKey pAT_ERROR_ID
noMethodBindingErrorName = mkWiredInIdName cONTROL_EXCEPTION (fsLit "noMethodBindingError")
noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
nonExhaustiveGuardsErrorName
= mkWiredInIdName gHC_ERR (fsLit "nonExhaustiveGuardsError")
......
......@@ -49,7 +49,6 @@ import Constants
import Data.List
import Foreign
import Foreign.C
import Control.Exception ( throwDyn )
import GHC.Exts ( Int(..), ByteArray# )
......@@ -1401,7 +1400,7 @@ idSizeW id = cgRepSizeW (typeCgRep (idType id))
-- See bug #1257
unboxedTupleException :: a
unboxedTupleException
= throwDyn
= ghcError
(ProgramError
("Error: bytecode compiler can't handle unboxed tuples.\n"++
" Possibly due to foreign import/export decls in source.\n"++
......
......@@ -42,7 +42,6 @@ import GHC.Word ( Word(..) )
import Data.Array.Base
import GHC.Arr ( STArray(..) )
import Control.Exception ( throwDyn )
import Control.Monad ( zipWithM )
import Control.Monad.ST ( stToIO )
......@@ -245,7 +244,7 @@ lookupIE ie con_nm
linkFail :: String -> String -> IO a
linkFail who what
= throwDyn (ProgramError $
= ghcError (ProgramError $
unlines [ ""
, "During interactive linking, GHCi couldn't find the following symbol:"
, ' ' : ' ' : what
......
......@@ -31,7 +31,7 @@ import Outputable
import SrcLoc
import PprTyThing
import Control.Exception
import Exception
import Control.Monad
import Data.List
import Data.Maybe
......
......@@ -28,7 +28,7 @@ import StaticFlags
import Data.Maybe
import Numeric
import Control.Exception as Exception
import Exception
import Data.Array
import Data.Char
import Data.Int ( Int64 )
......
......@@ -19,7 +19,7 @@ import Name (nameOccName)
import OccName (pprOccName)
import Data.Maybe
import Control.Exception
import Panic
import Data.List
import Control.Monad
import System.IO
......@@ -59,7 +59,7 @@ createTagsFile session tagskind tagFile = do
is_interpreted <- GHC.moduleIsInterpreted session m
-- should we just skip these?
when (not is_interpreted) $
throwDyn (CmdLineError ("module '"
ghcError (CmdLineError ("module '"
++ GHC.moduleNameString (GHC.moduleName m)
++ "' is not interpreted"))
mbModInfo <- GHC.getModuleInfo session m
......@@ -113,7 +113,7 @@ collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
tagGroups <- mapM tagFileGroup groups
IO.try (writeFile file $ concat tagGroups)
where
tagFileGroup [] = throwDyn (CmdLineError "empty tag file group??")
tagFileGroup [] = ghcError (CmdLineError "empty tag file group??")
tagFileGroup group@((_,fileName,_,_):_) = do
file <- readFile fileName -- need to get additional info from sources..
let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
......
......@@ -68,7 +68,7 @@ import System.Console.Editline.Readline as Readline
--import SystemExts
import Control.Exception as Exception
import Exception
-- import Control.Concurrent
import System.FilePath
......@@ -857,7 +857,7 @@ help :: String -> GHCi ()
help _ = io (putStr helpText)
info :: String -> GHCi ()
info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
info "" = ghcError (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
info s = do { let names = words s
; session <- getSession
; dflags <- getDynFlags
......@@ -947,7 +947,7 @@ editFile str =
st <- getGHCiState
let cmd = editor st
when (null cmd)
$ throwDyn (CmdLineError "editor not set, use :set editor")
$ ghcError (CmdLineError "editor not set, use :set editor")
io $ system (cmd ++ ' ':file)
return ()
......@@ -979,7 +979,7 @@ chooseEditFile =
do targets <- io (GHC.getTargets session)
case msum (map fromTarget targets) of
Just file -> return file
Nothing -> throwDyn (CmdLineError "No files to edit.")
Nothing -> ghcError (CmdLineError "No files to edit.")
where fromTarget (GHC.Target (GHC.TargetFile f _) _) = Just f
fromTarget _ = Nothing -- when would we get a module target?
......@@ -996,7 +996,7 @@ defineMacro overwrite s = do
unlines defined)
else do
if (not overwrite && macro_name `elem` defined)
then throwDyn (CmdLineError
then ghcError (CmdLineError
("macro '" ++ macro_name ++ "' is already defined"))
else do
......@@ -1025,7 +1025,7 @@ undefineMacro str = mapM_ undef (words str)
where undef macro_name = do
cmds <- io (readIORef macros_ref)
if (macro_name `notElem` map cmdName cmds)
then throwDyn (CmdLineError
then ghcError (CmdLineError
("macro '" ++ macro_name ++ "' is not defined"))
else do
io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds))
......@@ -1239,8 +1239,8 @@ browseCmd bang m =
case (as,bs) of
(as@(_:_), _) -> browseModule bang (last as) True
([], bs@(_:_)) -> browseModule bang (last bs) True
([], []) -> throwDyn (CmdLineError ":browse: no current module")
_ -> throwDyn (CmdLineError "syntax: :browse <module>")
([], []) -> ghcError (CmdLineError ":browse: no current module")
_ -> ghcError (CmdLineError "syntax: :browse <module>")
-- without bang, show items in context of their parents and omit children
-- with bang, show class methods and data constructors separately, and
......@@ -1264,7 +1264,7 @@ browseModule bang modl exports_only = do
mb_mod_info <- io $ GHC.getModuleInfo s modl
case mb_mod_info of
Nothing -> throwDyn (CmdLineError ("unknown module: " ++
Nothing -> ghcError (CmdLineError ("unknown module: " ++
GHC.moduleNameString (GHC.moduleName modl)))
Just mod_info -> do
dflags <- getDynFlags
......@@ -1336,7 +1336,7 @@ setContext str
playCtxtCmd True (cmd, as, bs)
st <- getGHCiState
setGHCiState st{ remembered_ctx = remembered_ctx st ++ [(cmd,as,bs)] }
| otherwise = throwDyn (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn")
| otherwise = ghcError (CmdLineError "syntax: :module [+/-] [*]M1 ... [*]Mn")
where
(cmd, strs, as, bs) =
case str of
......@@ -1507,7 +1507,7 @@ newDynFlags minus_opts = do
io $ handleFlagWarnings dflags' warns
if (not (null leftovers))
then throwDyn (CmdLineError ("unrecognised flags: " ++
then ghcError (CmdLineError ("unrecognised flags: " ++
unwords leftovers))
else return ()
......@@ -1541,7 +1541,7 @@ unsetOptions str
mapM_ unsetOpt plus_opts
let no_flag ('-':'f':rest) = return ("-fno-" ++ rest)
no_flag f = throwDyn (ProgramError ("don't know how to reverse " ++ f))
no_flag f = ghcError (ProgramError ("don't know how to reverse " ++ f))
no_flags <- mapM no_flag minus_opts
newDynFlags no_flags
......@@ -1596,7 +1596,7 @@ showCmd str = do
["context"] -> showContext
["packages"] -> showPackages
["languages"] -> showLanguages
_ -> throwDyn (CmdLineError ("syntax: :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
_ -> ghcError (CmdLineError ("syntax: :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
" | breaks | context | packages | languages ]"))
showModules :: GHCi ()
......@@ -1880,7 +1880,7 @@ wantInterpretedModule str = do
modl <- lookupModule str
is_interpreted <- io (GHC.moduleIsInterpreted session modl)
when (not is_interpreted) $
throwDyn (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
ghcError (CmdLineError ("module '" ++ str ++ "' is not interpreted"))
return modl
wantNameFromInterpretedModule :: (Name -> SDoc -> GHCi ()) -> String
......@@ -2094,7 +2094,7 @@ breakByModuleLine mod line args
| otherwise = breakSyntax
breakSyntax :: a
breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
breakSyntax = ghcError (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
findBreakAndSet mod lookupTickTree = do
......
......@@ -22,7 +22,6 @@ import Constants
import Foreign
import Foreign.C
import Text.Printf
import Control.Exception
----------------------------------------------------------------------------
......@@ -45,7 +44,7 @@ prepForeignCall cconv arg_types result_type
let res_ty = primRepToFFIType result_type
r <- ffi_prep_cif cif abi (fromIntegral n_args) res_ty arg_arr
if (r /= fFI_OK)
then throwDyn (InstallationError
then ghcError (InstallationError
(printf "prepForeignCallFailed: %d" (show r)))
else return cif
......
......@@ -77,7 +77,7 @@ import System.Directory
import Distribution.Package hiding (depends)
import Control.Exception
import Exception
import Data.Maybe
\end{code}
......@@ -263,7 +263,7 @@ getHValue :: HscEnv -> Name -> IO HValue
getHValue hsc_env name = do
when (isExternalName name) $ do
ok <- linkDependencies hsc_env noSrcSpan [nameModule name]
when (failed ok) $ throwDyn (ProgramError "")
when (failed ok) $ ghcError (ProgramError "")
pls <- readIORef v_PersistentLinkerState
lookupName (closure_env pls) name
......@@ -413,7 +413,7 @@ reallyInitDynLinker dflags
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done"
else throwDyn (InstallationError "linking extra libraries/objects failed")
else ghcError (InstallationError "linking extra libraries/objects failed")
}}
classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
......@@ -469,7 +469,7 @@ preloadLib dflags lib_paths framework_paths lib_spec
if not b then return False
else loadObj name >> return True
give_up = throwDyn $
give_up = ghcError $
CmdLineError "user specified .o/.so/.DLL could not be loaded."
\end{code}
......@@ -500,7 +500,7 @@ linkExpr hsc_env span root_ul_bco
-- Link the packages and modules required
; ok <- linkDependencies hsc_env span needed_mods
; if failed ok then
throwDyn (ProgramError "")
ghcError (ProgramError "")
else do {
-- Link the expression itself
......@@ -526,7 +526,7 @@ linkExpr hsc_env span root_ul_bco
-- by default, so we can safely ignore them here.
dieWith :: SrcSpan -> Message -> IO a
dieWith span msg = throwDyn (ProgramError (showSDoc (mkLocMessage span msg)))
dieWith span msg = ghcError (ProgramError (showSDoc (mkLocMessage span msg)))
checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe String)
......@@ -623,7 +623,7 @@ getLinkDeps hsc_env hpt _ maybe_normal_osuf span mods
link_boot_mod_error mod =
throwDyn (ProgramError (showSDoc (
ghcError (ProgramError (showSDoc (
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
......@@ -999,7 +999,7 @@ linkPackages dflags new_pkgs
; return (new_pkg : pkgs') }
| otherwise
= throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
= ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
linkPackage :: DynFlags -> PackageConfig -> IO ()
......@@ -1049,13 +1049,13 @@ linkPackage dflags pkg
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
else throwDyn (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'"))
load_dyn :: [FilePath] -> FilePath -> IO ()
load_dyn dirs dll = do r <- loadDynamic dirs dll
case r of
Nothing -> return ()
Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: "
Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
++ dll ++ " (" ++ err ++ ")" ))
loadFrameworks :: InstalledPackageInfo_ ModuleName -> IO ()
......@@ -1069,7 +1069,7 @@ loadFrameworks pkg
load fw = do r <- loadFramework fw_dirs fw
case r of
Nothing -> return ()
Just err -> throwDyn (CmdLineError ("can't load framework: "
Just err -> ghcError (CmdLineError ("can't load framework: "
++ fw ++ " (" ++ err ++ ")" ))
-- Try to find an object file for a given library in the given paths.
......@@ -1131,7 +1131,7 @@ mkSOName root
-- name. They are searched for in different paths than normal libraries.
loadFramework :: [FilePath] -> FilePath -> IO (Maybe String)
loadFramework extraPaths rootname
= do { either_dir <- Control.Exception.try getHomeDirectory
= do { either_dir <- Exception.try getHomeDirectory
; let homeFrameworkPath = case either_dir of
Left _ -> []
Right dir -> [dir ++ "/Library/Frameworks"]
......
......@@ -44,7 +44,6 @@ import Data.List
import Data.Word
import Data.Array
import Data.IORef
import Control.Exception
import Control.Monad
data CheckHiWay = CheckHiWay | IgnoreHiWay
......@@ -82,7 +81,7 @@ readBinIface_ checkHiWay traceBinIFaceReading hi_path nc = 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) $ throwDyn $ ProgramError
= when (wanted /= got) $ ghcError $ ProgramError
(what ++ " (wanted " ++ show wanted
++ ", got " ++ show got ++ ")")
bh <- Binary.readBinMem hi_path
......
......@@ -33,7 +33,6 @@ import FastString
import ErrUtils ( debugTraceMsg, putMsg )
import Control.Exception
import System.Exit ( ExitCode(..), exitWith )
import System.Directory
import System.FilePath
......@@ -171,7 +170,7 @@ processDeps :: DynFlags
processDeps _ _ _ _ (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
ghcError (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
processDeps dflags session excl_mods hdl (AcyclicSCC node)
= do { hsc_env <- GHC.sessionHscEnv session
......
......@@ -50,7 +50,7 @@ import SrcLoc ( unLoc )
import SrcLoc ( Located(..) )
import FastString
import Control.Exception as Exception
import Exception
import Data.IORef ( readIORef, writeIORef, IORef )
import GHC.Exts ( Int(..) )
import System.Directory
......@@ -351,7 +351,7 @@ compileFile :: HscEnv -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
compileFile hsc_env stop_phase (src, mb_phase) = do
exists <- doesFileExist src
when (not exists) $
throwDyn (CmdLineError ("does not exist: " ++ src))
ghcError (CmdLineError ("does not exist: " ++ src))
let
dflags = hsc_dflags hsc_env
......@@ -451,7 +451,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_phase) mb_basename output maybe_lo
-- before B in a normal compilation pipeline.
when (not (start_phase `happensBefore` stop_phase)) $
throwDyn (UsageError
ghcError (UsageError
("cannot compile this file to desired target: "
++ input_fn))
......@@ -777,7 +777,7 @@ runPhase (Hsc src_flavour) stop hsc_env basename suff input_fn get_output_fn _ma
Nothing -- No "module i of n" progress info
case mbResult of
Nothing -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
Nothing -> ghcError (PhaseFailed "hsc" (ExitFailure 1))
Just HscNoRecomp
-> do SysTools.touch dflags' "Touching object file" o_file
-- The .o file must have a later modification date
......@@ -818,7 +818,7 @@ runPhase Cmm stop hsc_env basename _ input_fn get_output_fn maybe_loc
ok <- hscCmmFile hsc_env' input_fn
when (not ok) $ throwDyn (PhaseFailed "cmm" (ExitFailure 1))
when (not ok) $ ghcError (PhaseFailed "cmm" (ExitFailure 1))
return (next_phase, dflags, maybe_loc, output_fn)
......@@ -1352,7 +1352,7 @@ linkBinary dflags o_files dep_packages = do
-- parallel only: move binary to another dir -- HWL
success <- runPhase_MoveBinary dflags output_fn dep_packages
if success then return ()
else throwDyn (InstallationError ("cannot move binary"))
else ghcError (InstallationError ("cannot move binary"))
exeFileName :: DynFlags -> FilePath
......
......@@ -69,7 +69,7 @@ import DriverPhases ( Phase(..), phaseInputExt )
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic ( panic, GhcException(..) )
import Panic
import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
......@@ -78,7 +78,6 @@ import Outputable
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.IORef ( readIORef )
import Control.Exception ( throwDyn )
import Control.Monad ( when )
import Data.Char
......@@ -1668,7 +1667,7 @@ parseDynamicFlags dflags args = do
let ((leftover, errs, warns), dflags')
= runCmdLine (processArgs dynamic_flags args') dflags
when (not (null errs)) $ do
throwDyn (UsageError (unlines errs))
ghcError (UsageError (unlines errs))
return (dflags', leftover, warns)
type DynP = CmdLineP DynFlags
......@@ -1760,7 +1759,7 @@ ignorePackage p =
setPackageName :: String -> DynFlags -> DynFlags
setPackageName p
| Nothing <- unpackPackageId pid
= throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
= ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
| otherwise
= \s -> s{ thisPackage = pid }
where
......
......@@ -274,7 +274,7 @@ import qualified Data.List as List
import Control.Monad
import System.Exit ( exitWith, ExitCode(..) )
import System.Time ( ClockTime, getClockTime )
import Control.Exception as Exception hiding (handle)
import Exception hiding (handle)
import Data.IORef
import System.FilePath
import System.IO
......@@ -1554,7 +1554,7 @@ topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
(graph, vertex_fn, key_fn) = graphFromEdges' nodes
root
| Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
| otherwise = throwDyn (ProgramError "module does not exist")
| otherwise = ghcError (ProgramError "module does not exist")
moduleGraphNodes :: Bool -> [ModSummary]
-> ([(ModSummary, Int, [Int])], HscSource -> ModuleName -> Maybe Int)
......@@ -2246,11 +2246,11 @@ findModule s mod_name maybe_pkg = withSession s $ \hsc_env ->
res <- findImportedModule hsc_env mod_name maybe_pkg
case res of
Found _ m | modulePackageId m /= this_pkg -> return m
| otherwise -> throwDyn (CmdLineError (showSDoc $
| otherwise -> ghcError (CmdLineError (showSDoc $
text "module" <+> quotes (ppr (moduleName m)) <+>
text "is not loaded"))
err -> let msg = cannotFindModule dflags mod_name err in
throwDyn (CmdLineError (showSDoc msg))
ghcError (CmdLineError (showSDoc msg))
#ifdef GHCI
getHistorySpan :: Session -> History -> IO SrcSpan
......
......@@ -40,7 +40,7 @@ import Panic
import Maybes
import Bag ( emptyBag, listToBag )
import Control.Exception
import Exception
import Control.Monad
import System.Exit
import System.IO
......@@ -87,7 +87,7 @@ getOptionsFromFile :: DynFlags
-> FilePath -- input file
-> IO [Located String] -- options, if any
getOptionsFromFile dflags filename
= Control.Exception.bracket
= Exception.bracket
(openBinaryFile filename ReadMode)
(hClose)
(\handle ->
......@@ -181,7 +181,7 @@ getOptions' dflags buf filename
checkProcessArgsResult :: [String] -> FilePath -> IO ()
checkProcessArgsResult flags filename
= do when (notNull flags) (throwDyn (ProgramError (
= do when (notNull flags) (ghcError (ProgramError (
showSDoc (hang (text filename <> char ':')
4 (text "unknown flags in {-# OPTIONS #-} pragma:" <+>
hsep (map text flags)))
......
......@@ -78,7 +78,7 @@ import Foreign
import Foreign.C
import GHC.Exts
import Data.Array
import Control.Exception as Exception
import Exception
import Control.Concurrent
import Data.List (sortBy)
import Data.IORef
......@@ -407,7 +407,7 @@ resume (Session ref) step
resume = ic_resume ic
case resume of
[] -> throwDyn (ProgramError "not stopped at a breakpoint")
[] -> ghcError (ProgramError "not stopped at a breakpoint")
(r:rs) -> do
-- unbind the temporary locals by restoring the TypeEnv from
-- before the breakpoint, and drop this Resume from the
......@@ -458,16 +458,16 @@ moveHist :: (Int -> Int) -> Session -> IO ([Name], Int, SrcSpan)
moveHist fn (Session ref) = do
hsc_env <- readIORef ref
case ic_resume (hsc_IC hsc_env) of
[] -> throwDyn (ProgramError "not stopped at a breakpoint")
[] -> ghcError (ProgramError "not stopped at a breakpoint")
(r:rs) -> do
let ix = resumeHistoryIx r
history = resumeHistory r
new_ix = fn ix
--
when (new_ix > length history) $
throwDyn (ProgramError "no more logged breakpoints")
ghcError (ProgramError "no more logged breakpoints")
when (new_ix < 0) $
throwDyn (ProgramError "already at the beginning of the history")
ghcError (ProgramError "already at the beginning of the history")
let
update_ic apStack mb_info = do
......@@ -775,12 +775,12 @@ vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
mkTopLevEnv hpt modl
= case lookupUFM hpt (moduleName modl) of
Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++
Nothing -> ghcError (ProgramError ("mkTopLevEnv: not a home module " ++
showSDoc (ppr modl)))
Just details ->
case mi_globals (hm_iface details) of
Nothing ->
throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
ghcError (ProgramError ("mkTopLevEnv: not interpreted "
++ showSDoc (ppr modl)))
Just env -> return env
......
......@@ -61,7 +61,6 @@ import System.FilePath
import Data.Maybe
import Control.Monad
import Data.List
import Control.Exception ( throwDyn )
-- ---------------------------------------------------------------------------
-- The Package state
......@@ -687,7 +686,7 @@ closeDeps pkg_map ps = throwErr (closeDepsErr pkg_map ps)
throwErr :: MaybeErr Message a -> IO a
throwErr m = case m of
Failed e -> throwDyn (CmdLineError (showSDoc e))
Failed e -> ghcError (CmdLineError (showSDoc e))
Succeeded r -> return r
closeDepsErr :: PackageConfigMap -> [(PackageId,Maybe PackageId)]
......@@ -710,7 +709,7 @@ add_package pkg_db ps (p, mb_parent)
return (p : ps')
missingPackageErr :: String -> IO [PackageConfig]
missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
missingPackageErr p = ghcError (CmdLineError (showSDoc (missingPackageMsg p)))
missingPackageMsg :: String -> SDoc
missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
......
......@@ -20,8 +20,7 @@ import StringBuffer
import ErrUtils ( mkLocMessage )
import SrcLoc
import Outputable
import Panic ( GhcException(..) )
import Control.Exception ( throwDyn )
import Panic
}
......@@ -162,7 +161,7 @@ loadPackageConfig dflags conf_filename = do
let loc = mkSrcLoc (mkFastString conf_filename) 1 0
case unP parse (mkPState buf loc dflags) of
PFailed span err ->
throwDyn (InstallationError (showSDoc (mkLocMessage span err)))
ghcError (InstallationError (showSDoc (mkLocMessage span err)))
POk _ pkg_details -> do
return pkg_details
......
......@@ -86,7 +86,6 @@ import Util
import Maybes ( firstJust )
import Panic
import Control.Exception ( throwDyn )
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad ( when )
......@@ -99,10 +98,10 @@ import Data.List
parseStaticFlags :: [String] -> IO ([String], [String])
parseStaticFlags args = do
ready <- readIORef v_opt_C_ready
when ready $ throwDyn (ProgramError "Too late for parseStaticFlags: call it before newSession")
when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
(leftover, errs, warns1) <- processArgs static_flags args
when (not (null errs)) $ throwDyn (UsageError (unlines errs))
when (not (null errs)) $ ghcError (UsageError (unlines errs))
-- deal with the way flags: the way (eg. prof) gives rise to
-- further flags, some of which might be static.
......@@ -463,7 +462,7 @@ decodeSize str
| c == "K" || c == "k" = truncate (n * 1000)
| c == "M" || c == "m" = truncate (n * 1000 * 1000)
| c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
| otherwise = throwDyn (CmdLineError ("can't decode size: " ++ str))
| otherwise = ghcError (CmdLineError ("can't decode size: " ++ str))
where (m, c) = span pred str
n = readRational m
pred c = isDigit c || c == '.'
......@@ -549,7 +548,7 @@ findBuildTag = do