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")
import Data.List
import Foreign
import Foreign.C
-import Control.Exception ( throwDyn )
import GHC.Exts ( Int(..), ByteArray# )
-- 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"++
import Data.Array.Base
import GHC.Arr ( STArray(..) )
-import Control.Exception ( throwDyn )
import Control.Monad ( zipWithM )
import Control.Monad.ST ( stToIO )
linkFail :: String -> String -> IO a
linkFail who what
- = throwDyn (ProgramError $
+ = ghcError (ProgramError $
unlines [ ""
, "During interactive linking, GHCi couldn't find the following symbol:"
, ' ' : ' ' : what
import SrcLoc
import PprTyThing
-import Control.Exception
+import Exception
import Control.Monad
import Data.List
import Data.Maybe
import Data.Maybe
import Numeric
-import Control.Exception as Exception
+import Exception
import Data.Array
import Data.Char
import Data.Int ( Int64 )
import OccName (pprOccName)
import Data.Maybe
-import Control.Exception
+import Panic
import Data.List
import Control.Monad
import System.IO
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
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
--import SystemExts
-import Control.Exception as Exception
+import Exception
-- import Control.Concurrent
import System.FilePath
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
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 ()
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?
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
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))
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
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
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
io $ handleFlagWarnings dflags' warns
if (not (null leftovers))
- then throwDyn (CmdLineError ("unrecognised flags: " ++
+ then ghcError (CmdLineError ("unrecognised flags: " ++
unwords leftovers))
else return ()
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
["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 ()
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
| 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
import Foreign
import Foreign.C
import Text.Printf
-import Control.Exception
----------------------------------------------------------------------------
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
import Distribution.Package hiding (depends)
-import Control.Exception
+import Exception
import Data.Maybe
\end{code}
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
; 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)
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}
-- 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
-- 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)
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")))
; return (new_pkg : pkgs') }
| otherwise
- = throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
+ = ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
linkPackage :: DynFlags -> PackageConfig -> IO ()
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 ()
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.
-- 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"]
import Data.Word
import Data.Array
import Data.IORef
-import Control.Exception
import Control.Monad
data CheckHiWay = CheckHiWay | IgnoreHiWay
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
import ErrUtils ( debugTraceMsg, putMsg )
-import Control.Exception
import System.Exit ( ExitCode(..), exitWith )
import System.Directory
import System.FilePath
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
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
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
-- 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))
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
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)
-- 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
import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
-import Panic ( panic, GhcException(..) )
+import Panic
import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.IORef ( readIORef )
-import Control.Exception ( throwDyn )
import Control.Monad ( when )
import Data.Char
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
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
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
(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)
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
import Maybes
import Bag ( emptyBag, listToBag )
-import Control.Exception
+import Exception
import Control.Monad
import System.Exit
import System.IO
-> FilePath -- input file
-> IO [Located String] -- options, if any
getOptionsFromFile dflags filename
- = Control.Exception.bracket
+ = Exception.bracket
(openBinaryFile filename ReadMode)
(hClose)
(\handle ->
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)))
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
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
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
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
import Data.Maybe
import Control.Monad
import Data.List
-import Control.Exception ( throwDyn )
-- ---------------------------------------------------------------------------
-- The Package state
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)]
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
import ErrUtils ( mkLocMessage )
import SrcLoc
import Outputable
-import Panic ( GhcException(..) )
-import Control.Exception ( throwDyn )
+import Panic
}
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
import Maybes ( firstJust )
import Panic
-import Control.Exception ( throwDyn )
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Control.Monad ( when )
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.
| 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 == '.'
let ws = sort (nub way_names)
if not (allowed_combination ws)
- then throwDyn (CmdLineError $
+ then ghcError (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
(map (wayName . lkupWay) ws))
import DynFlags
import FiniteMap
-import Control.Exception
+import Exception
import Data.IORef
import Control.Monad
import System.Exit
-- Check that the package config exists
; config_exists <- doesFileExist pkgconfig_path
; when (not config_exists) $
- throwDyn (InstallationError
+ ghcError (InstallationError
("Can't find package.conf as " ++ pkgconfig_path))
-- On Windows, gcc and friends are distributed with GHC,
-> do maybe_exec_dir <- getBaseDir -- Get directory of executable
case maybe_exec_dir of -- (only works on Windows;
-- returns Nothing on Unix)
- Nothing -> throwDyn (InstallationError "missing -B<dir> option")
+ Nothing -> ghcError (InstallationError "missing -B<dir> option")
Just dir -> return dir
\end{code}
then return (ExitFailure 1, True)
else IO.ioError err)
case (doesn'tExist, exit_code) of
- (True, _) -> throwDyn (InstallationError ("could not execute: " ++ pgm))
+ (True, _) -> ghcError (InstallationError ("could not execute: " ++ pgm))
(_, ExitSuccess) -> return ()
- _ -> throwDyn (PhaseFailed phase_name exit_code)
+ _ -> ghcError (PhaseFailed phase_name exit_code)
builderMainLoop :: DynFlags -> (String -> String) -> FilePath
-> [String] -> Maybe [(String, String)]
where
handle_exn _verb exn = do { debugTraceMsg dflags 2 (char '\n')
; debugTraceMsg dflags 2 (ptext (sLit "Failed:") <+> text cmd_line <+> text (show exn))
- ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
+ ; ghcError (PhaseFailed phase_name (ExitFailure 1)) }
\end{code}
%************************************************************************
gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL,
gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, gENERICS,
dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, aRROW,
- gHC_DESUGAR, rANDOM, gHC_EXTS :: Module
+ gHC_DESUGAR, rANDOM, gHC_EXTS, cONTROL_EXCEPTION :: Module
gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values
gHC_UNIT = mkPrimModule (fsLit "GHC.Unit")
gHC_BOOL = mkPrimModule (fsLit "GHC.Bool")
gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar")
rANDOM = mkBaseModule (fsLit "System.Random")
gHC_EXTS = mkBaseModule (fsLit "GHC.Exts")
+cONTROL_EXCEPTION = mkBaseModule (fsLit "Control.Exception")
mAIN, rOOT_MAIN :: Module
mAIN = mkMainModule_ mAIN_NAME
import System.IO
import Data.IORef
-import Control.Exception
import Control.Monad
\end{code}
import qualified Language.Haskell.TH.Syntax as TH
import GHC.Exts ( unsafeCoerce#, Int#, Int(..) )
-import qualified Control.Exception as Exception( userErrors )
+import qualified Exception ( userErrors )
\end{code}
Note [Template Haskell levels]
--- /dev/null
+
+module Exception
+ (
+#if __GLASGOW_HASKELL__ >= 609
+ module Control.OldException
+#else
+ module Control.Exception
+#endif
+ )
+ where
+
+import Prelude ()
+
+#if __GLASGOW_HASKELL__ >= 609
+import Control.OldException
+#else
+import Control.Exception
+#endif
+
import GHC.ConsoleHandler
#endif
-import Control.Exception
+import Exception
import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
import Data.Dynamic
-import qualified Control.Exception as Exception
import Debug.Trace ( trace )
import System.IO.Unsafe ( unsafePerformIO )
import System.IO.Error ( isUserError )
import Panic
-import Control.Exception ( Exception(..), finally, catchDyn, throw )
-import qualified Control.Exception as Exception
+import Exception ( Exception(..), finally, catchDyn, throw )
+import qualified Exception
import Data.Dynamic ( Typeable )
import Data.IORef ( IORef, newIORef )
import System.IO.Unsafe ( unsafePerformIO )
import Panic
-- Standard Haskell libraries
-import Control.Exception ( throwDyn )
import System.IO
import System.Environment
import System.Exit
#ifndef GHCI
interactiveUI :: a -> b -> c -> IO ()
interactiveUI _ _ _ =
- throwDyn (CmdLineError "not built for interactive use")
+ ghcError (CmdLineError "not built for interactive use")
#endif
-- -----------------------------------------------------------------------------
-- -prof and --interactive are not a good combination
when (notNull (filter (not . isRTSWay) (wayNames dflags))
&& isInterpretiveMode cli_mode) $
- do throwDyn (UsageError
+ do ghcError (UsageError
"--interactive can't be used with -prof or -unreg.")
-- -ohi sanity check
if (isJust (outputHi dflags) &&
(isCompManagerMode cli_mode || srcs `lengthExceeds` 1))
- then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
+ then ghcError (UsageError "-ohi can only be used when compiling a single source file")
else do
-- -o sanity checking
if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
&& not (isLinkMode cli_mode))
- then throwDyn (UsageError "can't apply -o to multiple source files")
+ then ghcError (UsageError "can't apply -o to multiple source files")
else do
-- Check that there are some input files
-- (except in the interactive case)
if null srcs && null objs && needsInputsMode cli_mode
- then throwDyn (UsageError "no input files")
+ then ghcError (UsageError "no input files")
else do
-- Verify that output files point somewhere sensible.
when (not flg) (nonExistentDir "-ohi" hi)
where
nonExistentDir flg dir =
- throwDyn (CmdLineError ("error: directory portion of " ++
+ ghcError (CmdLineError ("error: directory portion of " ++
show dir ++ " does not exist (used with " ++
show flg ++ " option.)"))
let ((leftover, errs, warns), (mode, _, flags')) =
runCmdLine (processArgs mode_flags args) (StopBefore StopLn, "", [])
when (not (null errs)) $ do
- throwDyn (UsageError (unlines errs))
+ ghcError (UsageError (unlines errs))
return (mode, flags' ++ leftover, warns)
type ModeM = CmdLineP (CmdLineMode, String, [String])
updateMode f flag = do
(old_mode, old_flag, flags') <- getCmdLineState
if notNull old_flag && flag /= old_flag
- then throwDyn (UsageError
+ then ghcError (UsageError
("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
else putCmdLineState (f old_mode, flag, flags')
-- Run --make mode
doMake :: Session -> [(String,Maybe Phase)] -> IO ()
-doMake _ [] = throwDyn (UsageError "no input files")
+doMake _ [] = ghcError (UsageError "no input files")
doMake sess srcs = do
let (hs_srcs, non_hs_srcs) = partition haskellish srcs
-- Util
unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs))
+unknownFlagsErr fs = ghcError (UsageError ("unrecognised flags: " ++ unwords fs))
PRELUDE_CLOSURE(base_GHCziIOBase_heapOverflow_closure);
PRELUDE_CLOSURE(base_GHCziIOBase_BlockedOnDeadMVar_closure);
PRELUDE_CLOSURE(base_GHCziIOBase_BlockedIndefinitely_closure);
-PRELUDE_CLOSURE(base_GHCziIOBase_nonTermination_closure);
-PRELUDE_CLOSURE(base_GHCziIOBase_NestedAtomically_closure);
+PRELUDE_CLOSURE(base_ControlziException_nonTermination_closure);
+PRELUDE_CLOSURE(base_ControlziException_nestedAtomically_closure);
PRELUDE_CLOSURE(base_GHCziConc_ensureIOManagerIsRunning_closure);
#define heapOverflow_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_heapOverflow_closure)
#define BlockedOnDeadMVar_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_BlockedOnDeadMVar_closure)
#define BlockedIndefinitely_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_BlockedIndefinitely_closure)
-#define nonTermination_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_nonTermination_closure)
-#define NestedAtomically_closure DLL_IMPORT_DATA_REF(base_GHCziIOBase_NestedAtomically_closure)
+#define nonTermination_closure DLL_IMPORT_DATA_REF(base_ControlziException_nonTermination_closure)
+#define NestedAtomically_closure DLL_IMPORT_DATA_REF(base_ControlziException_nestedAtomically_closure)
#define Czh_static_info DLL_IMPORT_DATA_REF(base_GHCziBase_Czh_static_info)
#define Fzh_static_info DLL_IMPORT_DATA_REF(base_GHCziFloat_Fzh_static_info)
import pthread_mutex_lock;
import pthread_mutex_unlock;
#endif
-import base_GHCziIOBase_NestedAtomically_closure;
+import base_ControlziException_nestedAtomically_closure;
import EnterCriticalSection;
import LeaveCriticalSection;
/* Nested transactions are not allowed; raise an exception */
if (old_trec != NO_TREC) {
- R1 = base_GHCziIOBase_NestedAtomically_closure;
+ R1 = base_ControlziException_nestedAtomically_closure;
jump raisezh_fast;
}
, "-u", "_base_GHCziPack_unpackCString_closure"
, "-u", "_base_GHCziIOBase_stackOverflow_closure"
, "-u", "_base_GHCziIOBase_heapOverflow_closure"
- , "-u", "_base_GHCziIOBase_nonTermination_closure"
+ , "-u", "_base_ControlziException_nonTermination_closure"
, "-u", "_base_GHCziIOBase_BlockedOnDeadMVar_closure"
, "-u", "_base_GHCziIOBase_BlockedIndefinitely_closure"
, "-u", "_base_GHCziIOBase_Deadlock_closure"
- , "-u", "_base_GHCziIOBase_NestedAtomically_closure"
+ , "-u", "_base_ControlziException_nestedAtomically_closure"
, "-u", "_base_GHCziWeak_runFinalizzerBatch_closure"
#else
"-u", "base_GHCziBase_Izh_static_info"
, "-u", "base_GHCziPack_unpackCString_closure"
, "-u", "base_GHCziIOBase_stackOverflow_closure"
, "-u", "base_GHCziIOBase_heapOverflow_closure"
- , "-u", "base_GHCziIOBase_nonTermination_closure"
+ , "-u", "base_ControlziException_nonTermination_closure"
, "-u", "base_GHCziIOBase_BlockedOnDeadMVar_closure"
, "-u", "base_GHCziIOBase_BlockedIndefinitely_closure"
, "-u", "base_GHCziIOBase_Deadlock_closure"
- , "-u", "base_GHCziIOBase_NestedAtomically_closure"
+ , "-u", "base_ControlziException_nestedAtomically_closure"
, "-u", "base_GHCziWeak_runFinalizzerBatch_closure"
#endif
projects / ghc-hetmet.git / commitdiff