Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
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
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