Skip to content

GitLab

GHC
GHC
Commit 4a5efba4 authored by dterei's avatar dterei
Browse files
Options

Tabs -> Spaces + formatting fixes

parent 14bbddac
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 427 additions and 443 deletions
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 ------------------
cmms <- if dopt Opt_TryNewCodeGen dflags
then tryNewCodeGen hsc_env this_mod data_tycons
cost_centre_info
......@@ -1182,7 +1182,7 @@ hscGenHardCode cgguts mod_summary = do
rawcmms <- cmmToRawCmm platform cmms
dumpIfSet_dyn dflags Opt_D_dump_raw_cmm "Raw Cmm" (pprPlatform platform rawcmms)
(_stub_h_exists, stub_c_exists)
<- codeOutput dflags this_mod location foreign_stubs
<- codeOutput dflags this_mod location foreign_stubs
dependencies rawcmms
return stub_c_exists
......@@ -1214,7 +1214,7 @@ hscInteractive (iface, details, cgguts) mod_summary = do
comp_bc <- liftIO $ byteCodeGen dflags this_mod prepd_binds
data_tycons mod_breaks
------------------ Create f-x-dynamic C-side stuff ---
(_istub_h_exists, istub_c_exists)
(_istub_h_exists, istub_c_exists)
<- liftIO $ outputForeignStubs dflags this_mod
location foreign_stubs
return (HscRecomp istub_c_exists (Just (comp_bc, mod_breaks))
......@@ -1252,7 +1252,7 @@ tryNewCodeGen hsc_env this_mod data_tycons
platform = targetPlatform dflags
prog <- StgCmm.codeGen dflags this_mod data_tycons
cost_centre_info stg_binds hpc_info
dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"
dumpIfSet_dyn dflags Opt_D_dump_cmmz "Cmm produced by new codegen"