Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4a5efba4
Commit
4a5efba4
authored
Nov 16, 2011
by
dterei
Browse files
Tabs -> Spaces + formatting fixes
parent
14bbddac
Changes
8
Expand all
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/Module.lhs
View file @
4a5efba4
...
...
@@ -9,14 +9,8 @@ These are Uniquable, hence we can build Maps with Modules as
the keys.
\begin{code}
{-# 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#TabsvsSpaces
-- for details
module Module
module Module
(
-- * The ModuleName type
ModuleName,
...
...
@@ -34,47 +28,47 @@ module Module
packageIdFS,
stringToPackageId,
packageIdString,
stablePackageIdCmp,
-- * Wired-in PackageIds
-- $wired_in_packages
primPackageId,
integerPackageId,
basePackageId,
rtsPackageId,
thPackageId,
stablePackageIdCmp,
-- * Wired-in PackageIds
-- $wired_in_packages
primPackageId,
integerPackageId,
basePackageId,
rtsPackageId,
thPackageId,
dphSeqPackageId,
dphParPackageId,
mainPackageId,
mainPackageId,
thisGhcPackageId,
-- * The Module type
Module,
modulePackageId, moduleName,
pprModule,
mkModule,
-- * The Module type
Module,
modulePackageId, moduleName,
pprModule,
mkModule,
stableModuleCmp,
-- * The ModuleLocation type
ModLocation(..),
addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
-- * Module mappings
ModuleEnv,
elemModuleEnv, extendModuleEnv, extendModuleEnvList,
extendModuleEnvList_C, plusModuleEnv_C,
delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
moduleEnvKeys, moduleEnvElts, moduleEnvToList,
-- * The ModuleLocation type
ModLocation(..),
addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
-- * Module mappings
ModuleEnv,
elemModuleEnv, extendModuleEnv, extendModuleEnvList,
extendModuleEnvList_C, plusModuleEnv_C,
delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
moduleEnvKeys, moduleEnvElts, moduleEnvToList,
unitModuleEnv, isEmptyModuleEnv,
foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
-- * ModuleName mappings
ModuleNameEnv,
-- * ModuleName mappings
ModuleNameEnv,
-- * Sets of Modules
ModuleSet,
emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
-- * Sets of Modules
ModuleSet,
emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
) where
#include "Typeable.h"
...
...
@@ -95,9 +89,9 @@ import System.FilePath
\end{code}
%************************************************************************
%*
*
%*
*
\subsection{Module locations}
%*
*
%*
*
%************************************************************************
\begin{code}
...
...
@@ -106,19 +100,19 @@ import System.FilePath
data ModLocation
= ModLocation {
ml_hs_file :: Maybe FilePath,
-- The source file, if we have one. Package modules
-- probably don't have source files.
-- The source file, if we have one. Package modules
-- probably don't have source files.
ml_hi_file :: FilePath,
-- Where the .hi file is, whether or not it exists
-- yet. Always of form foo.hi, even if there is an
-- hi-boot file (we add the -boot suffix later)
-- Where the .hi file is, whether or not it exists
-- yet. Always of form foo.hi, even if there is an
-- hi-boot file (we add the -boot suffix later)
ml_obj_file :: FilePath
-- Where the .o file is, whether or not it exists yet.
-- (might not exist either because the module hasn't
-- been compiled yet, or because it is part of a
-- package with a .a file)
-- Where the .o file is, whether or not it exists yet.
-- (might not exist either because the module hasn't
-- been compiled yet, or because it is part of a
-- package with a .a file)
} deriving Show
instance Outputable ModLocation where
...
...
@@ -126,7 +120,7 @@ instance Outputable ModLocation where
\end{code}
For a module in another package, the hs_file and obj_file
components of ModLocation are undefined.
components of ModLocation are undefined.
The locations specified by a ModLocation may or may not
correspond to actual files yet: for example, even if the object
...
...
@@ -148,15 +142,15 @@ addBootSuffixLocn :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all file paths associated with the module
addBootSuffixLocn locn
= locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
, ml_hi_file = addBootSuffix (ml_hi_file locn)
, ml_obj_file = addBootSuffix (ml_obj_file locn) }
, ml_hi_file = addBootSuffix (ml_hi_file locn)
, ml_obj_file = addBootSuffix (ml_obj_file locn) }
\end{code}
%************************************************************************
%*
*
%*
*
\subsection{The name of a module}
%*
*
%*
*
%************************************************************************
\begin{code}
...
...
@@ -194,11 +188,11 @@ stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName nm) =
pprModuleName (ModuleName nm) =
getPprStyle $ \ sty ->
if codeStyle sty
then ftext (zEncodeFS nm)
else ftext nm
if codeStyle sty
then ftext (zEncodeFS nm)
else ftext nm
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod
...
...
@@ -226,9 +220,9 @@ moduleNameColons = dots_to_colons . moduleNameString
\end{code}
%************************************************************************
%*
*
%*
*
\subsection{A fully qualified module}
%*
*
%*
*
%************************************************************************
\begin{code}
...
...
@@ -259,7 +253,7 @@ instance Data Module where
-- gives an ordering based on the 'Unique's of the components, which may
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module p1 n1) (Module p2 n2)
stableModuleCmp (Module p1 n1) (Module p2 n2)
= (p1 `stablePackageIdCmp` p2) `thenCmp`
(n1 `stableModuleNameCmp` n2)
...
...
@@ -274,8 +268,8 @@ pprPackagePrefix :: PackageId -> Module -> SDoc
pprPackagePrefix p mod = getPprStyle doc
where
doc sty
| codeStyle sty =
if p == mainPackageId
| codeStyle sty =
if p == mainPackageId
then empty -- never qualify the main package in code
else ftext (zEncodeFS (packageIdFS p)) <> char '_'
| qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
...
...
@@ -336,7 +330,7 @@ packageIdString = unpackFS . packageIdFS
-- -----------------------------------------------------------------------------
-- $wired_in_packages
-- Certain packages are known to the compiler, in that we know about certain
-- entities that reside in these packages, and the compiler needs to
-- entities that reside in these packages, and the compiler needs to
-- declare static Modules and Names that refer to these packages. Hence
-- the wired-in packages can't include version numbers, since we don't want
-- to bake the version numbers of these packages into GHC.
...
...
@@ -370,7 +364,7 @@ thisGhcPackageId = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
-- | This is the package Id for the current program. It is the default
-- package Id if you don't specify a package name. We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainPackageId
= fsToPackageId (fsLit "main")
mainPackageId
= fsToPackageId (fsLit "main")
\end{code}
%************************************************************************
...
...
@@ -452,7 +446,7 @@ foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
-- | A set of 'Module's
type ModuleSet = Map Module ()
mkModuleSet
:: [Module] -> ModuleSet
mkModuleSet
:: [Module] -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
emptyModuleSet :: ModuleSet
moduleSetElts :: ModuleSet -> [Module]
...
...
@@ -472,3 +466,4 @@ UniqFM.
-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
type ModuleNameEnv elt = UniqFM elt
\end{code}
compiler/main/DynFlags.hs
View file @
4a5efba4
...
...
@@ -397,7 +397,7 @@ data ExtensionFlag
|
Opt_RebindableSyntax
|
Opt_ConstraintKinds
|
Opt_PolyKinds
-- Kind polymorphism
|
Opt_StandaloneDeriving
|
Opt_DeriveDataTypeable
|
Opt_DeriveFunctor
...
...
@@ -1293,7 +1293,7 @@ parseDynamicFlags dflags0 args cmdline = do
-- check for disabled flags in safe haskell
let
(
dflags2
,
sh_warns
)
=
safeFlagCheck
dflags1
return
(
dflags2
,
leftover
,
sh_warns
++
warns
)
-- | Check (and potentially disable) any extensions that aren't allowed
...
...
@@ -1919,7 +1919,7 @@ xFlags = [
(
"RebindableSyntax"
,
Opt_RebindableSyntax
,
nop
),
(
"ConstraintKinds"
,
Opt_ConstraintKinds
,
nop
),
(
"PolyKinds"
,
Opt_PolyKinds
,
nop
),
(
"MonoPatBinds"
,
Opt_MonoPatBinds
,
(
"MonoPatBinds"
,
Opt_MonoPatBinds
,
\
turn_on
->
when
turn_on
$
deprecate
"Experimental feature now removed; has no effect"
),
(
"ExplicitForAll"
,
Opt_ExplicitForAll
,
nop
),
(
"AlternativeLayoutRule"
,
Opt_AlternativeLayoutRule
,
nop
),
...
...
compiler/main/ErrUtils.lhs
View file @
4a5efba4
...
...
@@ -4,49 +4,43 @@
\section[ErrsUtils]{Utilities for error reporting}
\begin{code}
{-# 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#TabsvsSpaces
-- for details
module ErrUtils (
Message, mkLocMessage, printError, pprMessageBag, pprErrMsgBag,
Severity(..),
Message, mkLocMessage, printError, pprMessageBag, pprErrMsgBag,
Severity(..),
ErrMsg, WarnMsg,
ErrMsg, WarnMsg,
ErrorMessages, WarningMessages,
errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
Messages, errorsFound, emptyMessages,
mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
printBagOfErrors, printBagOfWarnings,
warnIsErrorMsg, mkLongWarnMsg,
ghcExit,
doIfSet, doIfSet_dyn,
dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_or,
Messages, errorsFound, emptyMessages,
mkErrMsg, mkPlainErrMsg, mkLongErrMsg, mkWarnMsg, mkPlainWarnMsg,
printBagOfErrors, printBagOfWarnings,
warnIsErrorMsg, mkLongWarnMsg,
ghcExit,
doIfSet, doIfSet_dyn,
dumpIfSet, dumpIfSet_dyn, dumpIfSet_dyn_or,
mkDumpDoc, dumpSDoc,
-- * Messages during compilation
-- * Messages during compilation
putMsg, putMsgWith,
errorMsg,
fatalErrorMsg, fatalErrorMsg',
compilationProgressMsg,
showPass,
debugTraceMsg,
errorMsg,
fatalErrorMsg, fatalErrorMsg',
compilationProgressMsg,
showPass,
debugTraceMsg,
) where
#include "HsVersions.h"
import Bag
( Bag, bagToList, isEmptyBag, emptyBag )
import Util
( sortLe )
import Bag
( Bag, bagToList, isEmptyBag, emptyBag )
import Util
( sortLe )
import Outputable
import SrcLoc
import DynFlags
import StaticFlags
( opt_ErrorSpans )
import StaticFlags
( opt_ErrorSpans )
import System.Exit
( ExitCode(..), exitWith )
import System.Exit
( ExitCode(..), exitWith )
import Data.List
import qualified Data.Set as Set
import Data.IORef
...
...
@@ -84,13 +78,13 @@ printError span msg =
-- -----------------------------------------------------------------------------
-- Collecting up messages for later ordering and printing.
data ErrMsg = ErrMsg {
errMsgSpans :: [SrcSpan],
errMsgContext :: PrintUnqualified,
errMsgShortDoc :: Message,
errMsgExtraInfo :: Message
}
-- The SrcSpan is used for sorting errors into line-number order
data ErrMsg = ErrMsg {
errMsgSpans :: [SrcSpan],
errMsgContext :: PrintUnqualified,
errMsgShortDoc :: Message,
errMsgExtraInfo :: Message
}
-- The SrcSpan is used for sorting errors into line-number order
instance Show ErrMsg where
show em = showSDoc (errMsgShortDoc em)
...
...
@@ -113,7 +107,7 @@ mkPlainErrMsg locn msg
-- A long (multi-line) error message, with context to tell us whether
-- to qualify names in the message or not.
mkLongErrMsg :: SrcSpan -> PrintUnqualified -> Message -> Message -> ErrMsg
mkLongErrMsg locn print_unqual msg extra
mkLongErrMsg locn print_unqual msg extra
= ErrMsg { errMsgSpans = [locn], errMsgContext = print_unqual
, errMsgShortDoc = msg, errMsgExtraInfo = extra }
...
...
@@ -142,11 +136,11 @@ errorsFound :: DynFlags -> Messages -> Bool
errorsFound _dflags (_warns, errs) = not (isEmptyBag errs)
printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
printBagOfErrors dflags bag_of_errors =
printBagOfErrors dflags bag_of_errors =
printMsgBag dflags bag_of_errors SevError
printBagOfWarnings :: DynFlags -> Bag WarnMsg -> IO ()
printBagOfWarnings dflags bag_of_warns =
printBagOfWarnings dflags bag_of_warns =
printMsgBag dflags bag_of_warns SevWarning
pprErrMsgBag :: Bag ErrMsg -> [SDoc]
...
...
@@ -169,7 +163,7 @@ printMsgBag dflags bag sev
sortMsgBag :: Bag ErrMsg -> [ErrMsg]
sortMsgBag bag = sortLe srcOrder $ bagToList bag
where
srcOrder err1 err2 =
srcOrder err1 err2 =
case compare (head (errMsgSpans err1)) (head (errMsgSpans err2)) of
LT -> True
EQ -> True
...
...
@@ -179,15 +173,15 @@ ghcExit :: DynFlags -> Int -> IO ()
ghcExit dflags val
| val == 0 = exitWith ExitSuccess
| otherwise = do errorMsg dflags (text "\nCompilation had errors\n\n")
exitWith (ExitFailure val)
exitWith (ExitFailure val)
doIfSet :: Bool -> IO () -> IO ()
doIfSet flag action | flag = action
| otherwise = return ()
| otherwise = return ()
doIfSet_dyn :: DynFlags -> DynFlag -> IO () -> IO()
doIfSet_dyn dflags flag action | dopt flag dflags = action
| otherwise = return ()
| otherwise = return ()
-- -----------------------------------------------------------------------------
-- Dumping
...
...
@@ -199,7 +193,7 @@ dumpIfSet flag hdr doc
dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpIfSet_dyn dflags flag hdr doc
| dopt flag dflags || verbosity dflags >= 4
| dopt flag dflags || verbosity dflags >= 4
= dumpSDoc dflags flag hdr doc
| otherwise
= return ()
...
...
@@ -212,18 +206,18 @@ dumpIfSet_dyn_or dflags (flag : flags) hdr doc
else dumpIfSet_dyn_or dflags flags hdr doc
mkDumpDoc :: String -> SDoc -> SDoc
mkDumpDoc hdr doc
mkDumpDoc hdr doc
= vcat [blankLine,
line <+> text hdr <+> line,
doc,
blankLine]
where
line <+> text hdr <+> line,
doc,
blankLine]
where
line = text (replicate 20 '=')
-- | Write out a dump.
--
If --dump-to-file is set then this goes to a file.
--
otherwise emit to stdout.
--
If --dump-to-file is set then this goes to a file.
--
otherwise emit to stdout.
dumpSDoc :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
dumpSDoc dflags dflag hdr doc
= do let mFile = chooseDumpFile dflags dflag
...
...
@@ -253,36 +247,31 @@ dumpSDoc dflags dflag hdr doc
chooseDumpFile :: DynFlags -> DynFlag -> Maybe String
chooseDumpFile dflags dflag
-- dump file location is being forced
--
by the --ddump-file-prefix flag.
| dumpToFile
, Just prefix
<- dumpPrefixForce dflags
= Just $ prefix ++ (beautifyDumpName dflag)
-- dump file location is being forced
--
by the --ddump-file-prefix flag.
| dumpToFile
, Just prefix
<- dumpPrefixForce dflags
= Just $ prefix ++ (beautifyDumpName dflag)
-- dump file location chosen by DriverPipeline.runPipeline
| dumpToFile
, Just prefix
<- dumpPrefix dflags
= Just $ prefix ++ (beautifyDumpName dflag)
-- dump file location chosen by DriverPipeline.runPipeline
| dumpToFile
, Just prefix
<- dumpPrefix dflags
= Just $ prefix ++ (beautifyDumpName dflag)
-- we haven't got a place to put a dump file.
| otherwise
= Nothing
-- we haven't got a place to put a dump file.
| otherwise
= Nothing
where
dumpToFile = dopt Opt_DumpToFile dflags
where
dumpToFile = dopt Opt_DumpToFile dflags
-- | Build a nice file name from name of a DynFlag constructor
beautifyDumpName :: DynFlag -> String
beautifyDumpName dflag
= let str = show dflag
cut = if isPrefixOf "Opt_D_" str
then drop 6 str
else str
dash = map (\c -> case c of
'_' -> '-'
_ -> c)
cut
in dash
= let str = show dflag
cut = if isPrefixOf "Opt_D_" str then drop 6 str else str
dash = map (\c -> if c == '_' then '-' else c) cut
in dash
-- -----------------------------------------------------------------------------
...
...
@@ -321,10 +310,11 @@ compilationProgressMsg dflags msg
= ifVerbose dflags 1 (log_action dflags SevOutput noSrcSpan defaultUserStyle (text msg))
showPass :: DynFlags -> String -> IO ()
showPass dflags what
showPass dflags what
= ifVerbose dflags 2 (log_action dflags SevInfo noSrcSpan defaultUserStyle (text "***" <+> text what <> colon))
debugTraceMsg :: DynFlags -> Int -> Message -> IO ()
debugTraceMsg dflags val msg
= ifVerbose dflags val (log_action dflags SevInfo noSrcSpan defaultDumpStyle msg)
\end{code}
compiler/main/ErrUtils.lhs-boot
View file @
4a5efba4
...
...
@@ -15,3 +15,4 @@ type Message = SDoc
mkLocMessage :: SrcSpan -> Message -> Message
\end{code}
compiler/main/HscMain.hs
View file @
4a5efba4
...
...
@@ -27,7 +27,7 @@
-------------------------------------------------------------------------------
module
HscMain
(
(
-- * Making an HscEnv
newHscEnv
...
...
@@ -183,7 +183,7 @@ newHscEnv dflags = do
knownKeyNames
::
[
Name
]
-- Put here to avoid loops involving DsMeta,
knownKeyNames
=
-- where templateHaskellNames are defined
map
getName
wiredInThings
map
getName
wiredInThings
++
basicKnownKeyNames
#
ifdef
GHCI
++
templateHaskellNames
...
...
@@ -279,12 +279,12 @@ ioMsgMaybe' ioA = do
#
ifdef
GHCI
hscTcRnLookupRdrName
::
HscEnv
->
RdrName
->
IO
[
Name
]
hscTcRnLookupRdrName
hsc_env
rdr_name
=
hscTcRnLookupRdrName
hsc_env
rdr_name
=
runHsc
hsc_env
$
ioMsgMaybe
$
tcRnLookupRdrName
hsc_env
rdr_name
#
endif
hscTcRcLookupName
::
HscEnv
->
Name
->
IO
(
Maybe
TyThing
)
hscTcRcLookupName
hsc_env
name
=
hscTcRcLookupName
hsc_env
name
=
runHsc
hsc_env
$
ioMsgMaybe'
$
tcRnLookupName
hsc_env
name
-- ignore errors: the only error we're likely to get is
-- "name not found", and the Maybe in the return type
...
...
@@ -348,7 +348,7 @@ hscParse' mod_summary = do
-- XXX: should this really be a Maybe X? Check under which circumstances this
-- can become a Nothing and decide whether this should instead throw an
-- exception/signal an error.
type
RenamedStuff
=
type
RenamedStuff
=
(
Maybe
(
HsGroup
Name
,
[
LImportDecl
Name
],
Maybe
[
LIE
Name
],
Maybe
LHsDocString
))
...
...
@@ -357,7 +357,7 @@ hscTypecheckRename :: HscEnv -> ModSummary -> Located (HsModule RdrName)
->
IO
(
TcGblEnv
,
RenamedStuff
)
hscTypecheckRename
hsc_env
mod_summary
rdr_module
=
runHsc
hsc_env
$
do
tc_result
<-
{-# SCC "Typecheck-Rename" #-}
ioMsgMaybe
$
ioMsgMaybe
$
tcRnModule
hsc_env
(
ms_hsc_src
mod_summary
)
True
rdr_module
...
...
@@ -393,7 +393,7 @@ hscDesugar' mod_summary tc_result = do
makeSimpleIface
::
HscEnv
->
Maybe
ModIface
->
TcGblEnv
->
ModDetails
->
IO
(
ModIface
,
Bool
)
makeSimpleIface
hsc_env
maybe_old_iface
tc_result
details
=
runHsc
hsc_env
$
ioMsgMaybe
$
runHsc
hsc_env
$
ioMsgMaybe
$
mkIfaceTc
hsc_env
(
fmap
mi_iface_hash
maybe_old_iface
)
details
tc_result
-- | Make a 'ModDetails' from the results of typechecking. Used when
...
...
@@ -509,7 +509,7 @@ genericHscCompile compiler hscMessage hsc_env
=
do
(
recomp_reqd
,
mb_checked_iface
)
<-
{-# SCC "checkOldIface" #-}
checkOldIface
hsc_env
mod_summary
checkOldIface
hsc_env
mod_summary
source_modified
mb_old_iface0
-- save the interface that comes back from checkOldIface.
-- In one-shot mode we don't have the old iface until this
...
...
@@ -559,7 +559,7 @@ hscCheckRecompBackend compiler tc_result hsc_env mod_summary
let
mb_old_hash
=
fmap
mi_iface_hash
mb_checked_iface
case
mb_checked_iface
of
Just
iface
|
not
recomp_reqd
->
runHsc
hsc_env
$
->
runHsc
hsc_env
$
hscNoRecomp
compiler
iface
{
mi_globals
=
Just
(
tcg_rdr_env
tc_result
)
}
_otherwise
...
...
@@ -917,7 +917,7 @@ checkSafeImports dflags hsc_env tcg_env
case
safeInferOn
dflags
of
True
->
wipeTrust
tcg_env
errs
False
->
liftIO
.
throwIO
.
mkSrcErr
$
errs
-- All good matey!
False
->
do
when
(
packageTrustOn
dflags
)
$
checkPkgTrust
pkg_reqs
...
...
@@ -938,7 +938,7 @@ checkSafeImports dflags hsc_env tcg_env
-- inference mode is on.
let
s'
=
if
safeInferOn
dflags
then
True
else
s
return
(
m
,
l
,
s'
)
-- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
cond'
::
ImportedModsVal
->
ImportedModsVal
->
Hsc
ImportedModsVal
cond'
v1
@
(
m1
,
_
,
l1
,
s1
)
(
_
,
_
,
_
,
s2
)
...
...
@@ -1084,12 +1084,12 @@ hscSimplify' ds_result = do
hscSimpleIface
::
TcGblEnv
->
Maybe
Fingerprint
->
Hsc
(
ModIface
,
Bool
,
ModDetails
)
hscSimpleIface
tc_result
mb_old_iface
=
do
hscSimpleIface
tc_result
mb_old_iface
=
do
hsc_env
<-
getHscEnv
details
<-
liftIO
$
mkBootModDetailsTc
hsc_env
tc_result
(
new_iface
,
no_change
)
<-
{-# SCC "MkFinalIface" #-}
ioMsgMaybe
$
ioMsgMaybe
$
mkIfaceTc
hsc_env
mb_old_iface
details
tc_result
-- And the answer is ...
liftIO
$
dumpIfaceStats
hsc_env
...
...
@@ -1098,7 +1098,7 @@ hscSimpleIface tc_result mb_old_iface = do
hscNormalIface
::
ModGuts
->
Maybe
Fingerprint
->
Hsc
(
ModIface
,
Bool
,
ModDetails
,
CgGuts
)
hscNormalIface
simpl_result
mb_old_iface
=
do
hscNormalIface
simpl_result
mb_old_iface
=
do
hsc_env
<-
getHscEnv
(
cg_guts
,
details
)
<-
{-# SCC "CoreTidy" #-}
liftIO
$
tidyProgram
hsc_env
simpl_result
...
...
@@ -1110,7 +1110,7 @@ hscNormalIface simpl_result mb_old_iface = do
-- until after code output
(
new_iface
,
no_change
)
<-
{-# SCC "MkFinalIface" #-}
ioMsgMaybe
$
ioMsgMaybe
$
mkIface
hsc_env
mb_old_iface
details
simpl_result
-- Emit external core
...
...
@@ -1162,13 +1162,13 @@ hscGenHardCode cgguts mod_summary = do
----------------- Convert to STG ------------------
(
stg_binds
,
cost_centre_info
)
<-
{-# SCC "CoreToStg" #-}
myCoreToStg
dflags
this_mod
prepd_binds
myCoreToStg
dflags
this_mod
prepd_binds
let
prof_init
=
profilingInitCode
platform
this_mod
cost_centre_info
foreign_stubs
=
foreign_stubs0
`
appendStubC
`
prof_init
------------------ Code generation ------------------
<