Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
aa9a4f10
Commit
aa9a4f10
authored
Jul 30, 2008
by
Ian Lynagh
Browse files
Follow extensible exception changes
parent
179a3a7b
Changes
30
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/MkId.lhs
View file @
aa9a4f10
...
...
@@ -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")
...
...
compiler/ghci/ByteCodeGen.lhs
View file @
aa9a4f10
...
...
@@ -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"++
...
...
compiler/ghci/ByteCodeLink.lhs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/ghci/Debugger.hs
View file @
aa9a4f10
...
...
@@ -31,7 +31,7 @@ import Outputable
import
SrcLoc
import
PprTyThing
import
Control.
Exception
import
Exception
import
Control.Monad
import
Data.List
import
Data.Maybe
...
...
compiler/ghci/GhciMonad.hs
View file @
aa9a4f10
...
...
@@ -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
)
...
...
compiler/ghci/GhciTags.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/ghci/InteractiveUI.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/ghci/LibFFI.hsc
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/ghci/Linker.lhs
View file @
aa9a4f10
...
...
@@ -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"]
...
...
compiler/iface/BinIface.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/DriverMkDepend.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/DriverPipeline.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/DynFlags.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/GHC.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/HeaderInfo.hs
View file @
aa9a4f10
...
...
@@ -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
)))
...
...
compiler/main/InteractiveEval.hs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/Packages.lhs
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/ParsePkgConf.y
View file @
aa9a4f10
...
...
@@ -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
...
...
compiler/main/StaticFlags.hs
View file @
aa9a4f10
...
...
@@ -86,7 +86,6 @@ import Util
import
Maybes
(
firstJust
)
import
Panic