Commit f971e75e authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc

parents bb2f56a7 431e8047
......@@ -151,7 +151,6 @@ _darcs/
/libraries/plus.gif
/libraries/synopsis.png
/libraries/stamp/
/libraries/time/
/mk/are-validating.mk
/mk/build.mk
/mk/config.h
......
......@@ -34,3 +34,6 @@
[submodule "libraries/vector"]
path = libraries/vector
url = http://darcs.haskell.org/libraries/vector.git/
[submodule "libraries/time"]
path = libraries/time
url = http://darcs.haskell.org/libraries/time.git/
......@@ -85,51 +85,8 @@ sub sanity_check_tree {
# Create libraries/*/{ghc.mk,GNUmakefile}
sub boot_pkgs {
my @library_dirs = ();
my @tarballs = glob("libraries/tarballs/*");
my $tarball;
my $package;
my $stamp;
for $tarball (@tarballs) {
$package = $tarball;
$package =~ s#^libraries/tarballs/##;
$package =~ s/-[0-9.]*(-snapshot)?\.tar\.gz$//;
# Sanity check, so we don't rmtree the wrong thing below
if (($package eq "") || ($package =~ m#[/.\\]#)) {
die "Bad package name: $package";
}
if (-d "libraries/$package/_darcs") {
print "Ignoring libraries/$package as it looks like a darcs checkout\n"
}
elsif (-d "libraries/$package/.git") {
print "Ignoring libraries/$package as it looks like a git checkout\n"
}
else {
if (! -d "libraries/stamp") {
mkdir "libraries/stamp";
}
$stamp = "libraries/stamp/$package";
if ((! -d "libraries/$package") || (! -f "$stamp")
|| ((-M "libraries/stamp/$package") > (-M $tarball))) {
print "Unpacking $package\n";
if (-d "libraries/$package") {
&rmtree("libraries/$package")
or die "Can't remove libraries/$package: $!";
}
mkdir "libraries/$package"
or die "Can't create libraries/$package: $!";
system ("sh", "-c", "cd 'libraries/$package' && { cat ../../$tarball | gzip -d | tar xf - ; } && mv */* .") == 0
or die "Failed to unpack $package";
open STAMP, "> $stamp"
or die "Failed to open stamp file: $!";
close STAMP
or die "Failed to close stamp file: $!";
}
}
}
for $package (glob "libraries/*/") {
$package =~ s/\/$//;
......
......@@ -391,6 +391,7 @@ data DataCon
-- The actual fixity is stored elsewhere
dcPromoted :: Maybe TyCon -- The promoted TyCon if this DataCon is promotable
-- See Note [Promoted data constructors] in TyCon
}
deriving Data.Typeable.Typeable
......@@ -559,9 +560,10 @@ mkDataCon name declared_infix
mkFunTys rep_arg_tys $
mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
mb_promoted
| is_vanilla -- No existentials or context
, all (isLiftedTypeKind . tyVarKind) univ_tvs
mb_promoted -- See Note [Promoted data constructors] in TyCon
| all (isLiftedTypeKind . tyVarKind) (univ_tvs ++ ex_tvs)
-- No kind polymorphism, and all of kind *
, null full_theta -- No constraints
, all isPromotableType orig_arg_tys
= Just (mkPromotedDataCon con name (getUnique name) prom_kind arity)
| otherwise
......
......@@ -183,12 +183,15 @@ cpsTop hsc_env proc =
-- the entry point.
splitting_proc_points = hscTarget dflags /= HscAsm
|| not (tablesNextToCode dflags)
|| usingDarwinX86Pic -- Note [darwin-x86-pic]
usingDarwinX86Pic = platformArch platform == ArchX86
&& platformOS platform == OSDarwin
&& gopt Opt_PIC dflags
|| -- Note [inconsistent-pic-reg]
usingInconsistentPicReg
usingInconsistentPicReg = ( platformArch platform == ArchX86 ||
platformArch platform == ArchPPC
)
&& platformOS platform == OSDarwin
&& gopt Opt_PIC dflags
{- Note [darwin-x86-pic]
{- Note [inconsistent-pic-reg]
On x86/Darwin, PIC is implemented by inserting a sequence like
......@@ -205,6 +208,12 @@ points, then at the join point we don't have a consistent value for
Hence, on x86/Darwin, we have to split proc points, and then each proc
point will get its own PIC initialisation sequence.
The situation is the same for ppc/Darwin. We use essentially the same
sequence to load the program counter onto reg:
bcl 20,31,1f
1: mflr reg
This isn't an issue on x86/ELF, where the sequence is
call 1f
......
......@@ -55,6 +55,18 @@ import MonadUtils
import Data.Maybe
\end{code}
Note [GHC Formalism]
~~~~~~~~~~~~~~~~~~~~
This file implements the type-checking algorithm for System FC, the "official"
name of the Core language. Type safety of FC is heart of the claim that
executables produced by GHC do not have segmentation faults. Thus, it is
useful to be able to reason about System FC independently of reading the code.
To this purpose, there is a document ghc.pdf built in docs/core-spec that
contains a formalism of the types and functions dealt with here. If you change
just about anything in this file or you change other types/functions throughout
the Core language (all signposted to this note), you should update that
formalism. See docs/core-spec/README for more info about how to do so.
%************************************************************************
%* *
\subsection[lintCoreBindings]{@lintCoreBindings@: Top-level interface}
......@@ -109,6 +121,8 @@ find an occurence of an Id, we fetch it from the in-scope set.
\begin{code}
lintCoreBindings :: CoreProgram -> (Bag MsgDoc, Bag MsgDoc)
-- Returns (warnings, errors)
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintCoreBindings binds
= initL $
addLoc TopLevelBindings $
......@@ -135,6 +149,8 @@ lintCoreBindings binds
= compare (m1, nameOccName n1) (m2, nameOccName n2)
| otherwise = LT
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lint_bind (Rec prs) = mapM_ (lintSingleBinding TopLevel Recursive) prs
lint_bind (NonRec bndr rhs) = lintSingleBinding TopLevel NonRecursive (bndr,rhs)
\end{code}
......@@ -173,6 +189,8 @@ Check a core binding, returning the list of variables bound.
\begin{code}
lintSingleBinding :: TopLevelFlag -> RecFlag -> (Id, CoreExpr) -> LintM ()
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
= addLoc (RhsOf binder) $
-- Check the rhs
......@@ -214,6 +232,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
binder_ty = idType binder
maybeDmdTy = idStrictness_maybe binder
bndr_vars = varSetElems (idFreeVars binder)
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintBinder var | isId var = lintIdBndr var $ \_ -> (return ())
| otherwise = return ()
\end{code}
......@@ -251,6 +272,8 @@ lintCoreExpr :: CoreExpr -> LintM OutType
--
-- The returned "type" can be a kind, if the expression is (Type ty)
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintCoreExpr (Var var)
= do { checkL (not (var == oneTupleDataConId))
(ptext (sLit "Illegal one-tuple"))
......@@ -356,14 +379,16 @@ lintCoreExpr e@(Case scrut var alt_ty alts) =
; checkCaseAlts e scrut_ty alts
; return alt_ty } }
-- This case can't happen; linting types in expressions gets routed through
-- lintCoreArgs
lintCoreExpr (Type ty)
= do { ty' <- lintInTy ty
; return (typeKind ty') }
= pprPanic "lintCoreExpr" (ppr ty)
lintCoreExpr (Coercion co)
= do { co' <- lintInCo co
; let Pair ty1 ty2 = coercionKind co'
; return (mkCoercionType ty1 ty2) }
\end{code}
Note [Kind instantiation in coercions]
......@@ -410,6 +435,8 @@ lintAltBinders :: OutType -- Scrutinee type
-> OutType -- Constructor type
-> [OutVar] -- Binders
-> LintM ()
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintAltBinders scrut_ty con_ty []
= checkTys con_ty scrut_ty (mkBadPatMsg con_ty scrut_ty)
lintAltBinders scrut_ty con_ty (bndr:bndrs)
......@@ -447,6 +474,9 @@ lintValApp arg fun_ty arg_ty
\begin{code}
checkTyKind :: OutTyVar -> OutType -> LintM ()
-- Both args have had substitution applied
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
checkTyKind tyvar arg_ty
| isSuperKind tyvar_kind -- kind forall
= lintKind arg_ty
......@@ -520,7 +550,8 @@ lintCoreAlt :: OutType -- Type of scrutinee
-> OutType -- Type of the alternative
-> CoreAlt
-> LintM ()
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintCoreAlt _ alt_ty (DEFAULT, args, rhs) =
do { checkL (null args) (mkDefaultArgsMsg args)
; checkAltExpr rhs alt_ty }
......@@ -572,6 +603,8 @@ lintBinders (var:vars) linterF = lintBinder var $ \var' ->
lintBinders vars $ \ vars' ->
linterF (var':vars')
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintBinder :: Var -> (Var -> LintM a) -> LintM a
lintBinder var linterF
| isId var = lintIdBndr var linterF
......@@ -638,6 +671,9 @@ lintTyBndrKind tv = lintKind (tyVarKind tv)
-------------------
lintType :: OutType -> LintM LintedKind
-- The returned Kind has itself been linted
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintType (TyVarTy tv)
= do { checkTyCoVarInScope tv
; return (tyVarKind tv) }
......@@ -673,6 +709,8 @@ lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty)
\begin{code}
lintKind :: OutKind -> LintM ()
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintKind k = do { sk <- lintType k
; unless (isSuperKind sk)
(addErrL (hang (ptext (sLit "Ill-kinded kind:") <+> ppr k)
......@@ -682,6 +720,8 @@ lintKind k = do { sk <- lintType k
\begin{code}
lintArrow :: SDoc -> LintedKind -> LintedKind -> LintM LintedKind
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintArrow what k1 k2 -- Eg lintArrow "type or kind `blah'" k1 k2
-- or lintarrow "coercion `blah'" k1 k2
| isSuperKind k1
......@@ -718,6 +758,9 @@ lint_app :: SDoc -> LintedKind -> [(LintedType,LintedKind)] -> LintM Kind
-- We have an application (f arg_ty1 .. arg_tyn),
-- where f :: fun_kind
-- Takes care of linting the OutTypes
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lint_app doc kfn kas
= foldlM go_app kfn kas
where
......@@ -760,6 +803,9 @@ lintCoercion :: OutCoercion -> LintM (LintedKind, LintedType, LintedType)
-- Check the kind of a coercion term, returning the kind
-- Post-condition: the returned OutTypes are lint-free
-- and have the same kind as each other
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintCoercion (Refl ty)
= do { k <- lintType ty
; return (k, ty, ty) }
......@@ -899,6 +945,9 @@ lintCoercion co@(AxiomInstCo (CoAxiom { co_ax_tvs = ktvs
%************************************************************************
\begin{code}
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism]
newtype LintM a =
LintM { unLintM ::
[LintLocInfo] -> -- Locations
......
......@@ -261,6 +261,9 @@ These data types are the heart of the compiler
-- * A type: this should only show up at the top level of an Arg
--
-- * A coercion
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
data Expr b
= Var Id
| Lit Literal
......@@ -281,9 +284,15 @@ type Arg b = Expr b
-- | A case split alternative. Consists of the constructor leading to the alternative,
-- the variables bound from the constructor, and the expression to be executed given that binding.
-- The default alternative is @(DEFAULT, [], rhs)@
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
type Alt b = (AltCon, [b], Expr b)
-- | A case alternative constructor (i.e. pattern match)
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
data AltCon
= DataAlt DataCon -- ^ A plain data constructor: @case e of { Foo x -> ... }@.
-- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
......@@ -296,6 +305,9 @@ data AltCon
deriving (Eq, Ord, Data, Typeable)
-- | Binding, used for top level bindings in a module and local bindings in a @let@.
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
data Bind b = NonRec b (Expr b)
| Rec [(b, (Expr b))]
deriving (Data, Typeable)
......@@ -423,6 +435,9 @@ unboxed type.
\begin{code}
-- | Allows attaching extra information to points in expressions
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
data Tickish id =
-- | An @{-# SCC #-}@ profiling annotation, either automatically
-- added by the desugarer as a result of -auto-all, or added by
......@@ -1049,6 +1064,9 @@ a list of CoreBind
chunks.
\begin{code}
-- If you edit this type, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
type CoreProgram = [CoreBind] -- See Note [CoreProgram]
-- | The common case for the type of binders and variables when
......@@ -1213,6 +1231,8 @@ varsToCoreExprs vs = map varToCoreExpr vs
\begin{code}
-- | Extract every variable by this group
bindersOf :: Bind b -> [b]
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
bindersOf (NonRec binder _) = [binder]
bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
......
......@@ -50,7 +50,7 @@ Library
Build-Depends: base >= 4 && < 5,
directory >= 1 && < 1.3,
process >= 1 && < 1.2,
process >= 1 && < 1.3,
bytestring >= 0.9 && < 0.11,
time < 1.5,
containers >= 0.1 && < 0.6,
......
......@@ -500,7 +500,10 @@ $(foreach way,$$(compiler_stage3_WAYS),\
compiler/prelude/PrimOp_HC_OPTS += -fforce-recomp
# LibFFI.hs #includes ffi.h
ifneq "$(UseSystemLibFFI)" "YES"
compiler/stage2/build/LibFFI.hs : $(libffi_HEADERS)
endif
# On Windows it seems we also need to link directly to libffi
ifeq "$(HostOS_CPP)" "mingw32"
define windowsDynLinkToFfi
......
......@@ -1465,7 +1465,7 @@ bcIdUnaryType x = case repType (idType x) of
-- See bug #1257
unboxedTupleException :: a
unboxedTupleException
= ghcError
= throwGhcException
(ProgramError
("Error: bytecode compiler can't handle unboxed tuples.\n"++
" Possibly due to foreign import/export decls in source.\n"++
......
......@@ -240,7 +240,7 @@ lookupIE dflags ie con_nm
linkFail :: String -> String -> IO a
linkFail who what
= ghcError (ProgramError $
= throwGhcException (ProgramError $
unlines [ "",who
, "During interactive linking, GHCi couldn't find the following symbol:"
, ' ' : ' ' : what
......
......@@ -8,13 +8,6 @@
#include <ffi.h>
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSp
-- for details
module LibFFI (
ForeignCallToken,
prepForeignCall
......@@ -23,12 +16,11 @@ module LibFFI (
import TyCon
import ForeignCall
import Panic
-- import Outputable
import DynFlags
import Control.Monad
import Foreign
import Foreign.C
import Text.Printf
----------------------------------------------------------------------------
......@@ -45,17 +37,17 @@ prepForeignCall dflags cconv arg_types result_type
= do
let n_args = length arg_types
arg_arr <- mallocArray n_args
let init_arg (ty,n) = pokeElemOff arg_arr n (primRepToFFIType dflags ty)
mapM_ init_arg (zip arg_types [0..])
let init_arg ty n = pokeElemOff arg_arr n (primRepToFFIType dflags ty)
zipWithM_ init_arg arg_types [0..]
cif <- mallocBytes (#const sizeof(ffi_cif))
let abi = convToABI cconv
let res_ty = primRepToFFIType dflags result_type
r <- ffi_prep_cif cif abi (fromIntegral n_args) res_ty arg_arr
if (r /= fFI_OK)
then ghcError (InstallationError
(printf "prepForeignCallFailed: %d" (show r)))
then throwGhcException (InstallationError
("prepForeignCallFailed: " ++ show r))
else return cif
convToABI :: CCallConv -> C_ffi_abi
convToABI CCallConv = fFI_DEFAULT_ABI
#if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH)
......@@ -69,7 +61,7 @@ primRepToFFIType :: DynFlags -> PrimRep -> Ptr C_ffi_type
primRepToFFIType dflags r
= case r of
VoidRep -> ffi_type_void
IntRep -> signed_word
IntRep -> signed_word
WordRep -> unsigned_word
Int64Rep -> ffi_type_sint64
Word64Rep -> ffi_type_uint64
......@@ -118,10 +110,10 @@ fFI_STDCALL = (#const FFI_STDCALL)
#endif
-- ffi_status ffi_prep_cif(ffi_cif *cif,
-- ffi_abi abi,
-- unsigned int nargs,
-- ffi_type *rtype,
-- ffi_type **atypes);
-- ffi_abi abi,
-- unsigned int nargs,
-- ffi_type *rtype,
-- ffi_type **atypes);
foreign import ccall "ffi_prep_cif"
ffi_prep_cif :: Ptr C_ffi_cif -- cif
......@@ -134,9 +126,9 @@ foreign import ccall "ffi_prep_cif"
-- Currently unused:
-- void ffi_call(ffi_cif *cif,
-- void (*fn)(),
-- void *rvalue,
-- void **avalue);
-- void (*fn)(),
-- void *rvalue,
-- void **avalue);
-- foreign import ccall "ffi_call"
-- ffi_call :: Ptr C_ffi_cif -- cif
......
......@@ -172,7 +172,7 @@ getHValue hsc_env name = do
pls <- modifyPLS $ \pls -> do
if (isExternalName name) then do
(pls', ok) <- linkDependencies hsc_env pls noSrcSpan [nameModule name]
if (failed ok) then ghcError (ProgramError "")
if (failed ok) then throwGhcException (ProgramError "")
else return (pls', pls')
else
return (pls, pls)
......@@ -321,7 +321,7 @@ reallyInitDynLinker dflags =
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done"
else ghcError (ProgramError "linking extra libraries/objects failed")
else throwGhcException (ProgramError "linking extra libraries/objects failed")
; return pls
}}
......@@ -403,7 +403,7 @@ preloadLib dflags lib_paths framework_paths lib_spec
preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
preloadFailed sys_errmsg paths spec
= do maybePutStr dflags "failed.\n"
ghcError $
throwGhcException $
CmdLineError (
"user specified .o/.so/.DLL could not be loaded ("
++ sys_errmsg ++ ")\nWhilst trying to load: "
......@@ -455,7 +455,7 @@ linkExpr hsc_env span root_ul_bco
-- Link the packages and modules required
; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
; if failed ok then
ghcError (ProgramError "")
throwGhcException (ProgramError "")
else do {
-- Link the expression itself
......@@ -480,7 +480,7 @@ linkExpr hsc_env span root_ul_bco
-- by default, so we can safely ignore them here.
dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a
dieWith dflags span msg = ghcError (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
dieWith dflags span msg = throwGhcException (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
checkNonStdWay :: DynFlags -> SrcSpan -> IO Bool
......@@ -566,7 +566,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
mb_iface <- initIfaceCheck hsc_env $
loadInterface msg mod (ImportByUser False)
iface <- case mb_iface of
Maybes.Failed err -> ghcError (ProgramError (showSDoc dflags err))
Maybes.Failed err -> throwGhcException (ProgramError (showSDoc dflags err))
Maybes.Succeeded iface -> return iface
when (mi_boot iface) $ link_boot_mod_error mod
......@@ -594,7 +594,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
link_boot_mod_error mod =
ghcError (ProgramError (showSDoc dflags (
throwGhcException (ProgramError (showSDoc dflags (
text "module" <+> ppr mod <+>
text "cannot be linked; it is only available as a boot module")))
......@@ -677,7 +677,7 @@ linkDecls hsc_env span (ByteCode unlinkedBCOs itblEnv) = do
-- Link the packages and modules required
(pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
if failed ok
then ghcError (ProgramError "")
then throwGhcException (ProgramError "")
else do
-- Link the expression itself
......@@ -717,7 +717,7 @@ linkModule hsc_env mod = do
initDynLinker (hsc_dflags hsc_env)
modifyPLS_ $ \pls -> do
(pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod]
if (failed ok) then ghcError (ProgramError "could not link module")
if (failed ok) then throwGhcException (ProgramError "could not link module")
else return pls'
\end{code}
......@@ -1084,7 +1084,7 @@ linkPackages' dflags new_pks pls = do
; return (new_pkg : pkgs') }
| otherwise
= ghcError (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
= throwGhcException (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
linkPackage :: DynFlags -> PackageConfig -> IO ()
......@@ -1140,7 +1140,7 @@ linkPackage dflags pkg
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
else throwGhcException (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'"))
-- we have already searched the filesystem; the strings passed to load_dyn
-- can be passed directly to loadDLL. They are either fully-qualified
......@@ -1151,7 +1151,7 @@ load_dyn :: FilePath -> IO ()
load_dyn dll = do r <- loadDLL dll
case r of
Nothing -> return ()
Just err -> ghcError (CmdLineError ("can't load .so/.DLL for: "
Just err -> throwGhcException (CmdLineError ("can't load .so/.DLL for: "
++ dll ++ " (" ++ err ++ ")" ))
loadFrameworks :: Platform -> InstalledPackageInfo_ ModuleName -> IO ()
......@@ -1166,7 +1166,7 @@ loadFrameworks platform pkg
load fw = do r <- loadFramework fw_dirs fw
case r of
Nothing -> return ()
Just err -> ghcError (CmdLineError ("can't load framework: "
Just err -> throwGhcException (CmdLineError ("can't load framework: "
++ fw ++ " (" ++ err ++ ")" ))
-- Try to find an object file for a given library in the given paths.
......
......@@ -98,7 +98,7 @@ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu = do
errorOnMismatch what wanted got =
-- This will be caught by readIface which will emit an error
-- msg containing the iface module name.
when (wanted /= got) $ ghcError $ ProgramError
when (wanted /= got) $ throwGhcException $ ProgramError
(what ++ " (wanted " ++ show wanted
++ ", got " ++ show got ++ ")")
bh <- Binary.readBinMem hi_path
......
......@@ -213,7 +213,7 @@ data IfaceIdInfo
-- (In earlier GHCs we used to drop IdInfo immediately on reading,
-- but we do not do that now. Instead it's discarded when the
-- ModIface is read into the various decl pools.)
-- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
-- * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
-- and so gives a new version.
data IfaceInfoItem
......
......@@ -166,7 +166,7 @@ loadInterfaceWithException doc mod_name where_from
= do { mb_iface <- loadInterface doc mod_name where_from
; dflags <- getDynFlags
; case mb_iface of
Failed err -> ghcError (ProgramError (showSDoc dflags err))
Failed err -> throwGhcException (ProgramError (showSDoc dflags err))
Succeeded iface -> return iface }
------------------
......
......@@ -829,7 +829,7 @@ oldMD5 dflags bh = do
let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
r <- system cmd
case r of
ExitFailure _ -> ghcError (PhaseFailed cmd r)
ExitFailure _ -> throwGhcException (PhaseFailed cmd r)
ExitSuccess -> do
hash_str <- readFile tmp2
return $! readHexFingerprint hash_str
......
......@@ -65,7 +65,7 @@ doMkDependHS srcs = do
_ <- GHC.setSessionDynFlags dflags
when (null (depSuffixes dflags)) $
ghcError (ProgramError "You must specify at least one -dep-suffix")
throwGhcException (ProgramError "You must specify at least one -dep-suffix")
files <- liftIO $ beginMkDependHS dflags
......@@ -193,7 +193,7 @@ processDeps :: DynFlags
processDeps dflags _ _ _ _ (CyclicSCC nodes)