Commit d1c1b7d0 authored by simonmar's avatar simonmar

[project @ 2005-03-18 13:37:27 by simonmar]

Flags cleanup.

Basically the purpose of this commit is to move more of the compiler's
global state into DynFlags, which is moving in the direction we need
to go for the GHC API which can have multiple active sessions
supported by a single GHC instance.

Before:

$ grep 'global_var' */*hs | wc -l
     78

After:

$ grep 'global_var' */*hs | wc -l
     27

Well, it's an improvement.  Most of what's left won't really affect
our ability to host multiple sessions.

Lots of static flags have become dynamic flags (yay!).  Notably lots
of flags that we used to think of as "driver" flags, like -I and -L,
are now dynamic.  The most notable static flags left behind are the
"way" flags, eg. -prof.  It would be nice to fix this, but it isn't
urgent.

On the way, lots of cleanup has happened.  Everything related to
static and dynamic flags lives in StaticFlags and DynFlags
respectively, and they share a common command-line parser library in
CmdLineParser.  The flags related to modes (--makde, --interactive
etc.) are now private to the front end: in fact private to Main
itself, for now.
parent 6a51f7df
...@@ -112,7 +112,7 @@ import Maybes ( orElse ) ...@@ -112,7 +112,7 @@ import Maybes ( orElse )
import SrcLoc ( SrcLoc ) import SrcLoc ( SrcLoc )
import Outputable import Outputable
import Unique ( Unique, mkBuiltinUnique ) import Unique ( Unique, mkBuiltinUnique )
import CmdLineOpts ( opt_NoStateHack ) import StaticFlags ( opt_NoStateHack )
-- infixl so you can say (id `set` a `set` b) -- infixl so you can say (id `set` a `set` b)
infixl 1 `setIdUnfolding`, infixl 1 `setIdUnfolding`,
......
...@@ -24,7 +24,7 @@ module NewDemand( ...@@ -24,7 +24,7 @@ module NewDemand(
#include "HsVersions.h" #include "HsVersions.h"
import CmdLineOpts ( opt_CprOff ) import StaticFlags ( opt_CprOff )
import BasicTypes ( Arity ) import BasicTypes ( Arity )
import VarEnv ( VarEnv, emptyVarEnv, isEmptyVarEnv ) import VarEnv ( VarEnv, emptyVarEnv, isEmptyVarEnv )
import UniqFM ( ufmToList ) import UniqFM ( ufmToList )
......
...@@ -41,7 +41,7 @@ import UniqFM ...@@ -41,7 +41,7 @@ import UniqFM
import Unique ( Unique, deriveUnique, getUnique ) import Unique ( Unique, deriveUnique, getUnique )
import Util ( zipEqual, foldl2 ) import Util ( zipEqual, foldl2 )
import Maybes ( orElse, isJust ) import Maybes ( orElse, isJust )
import CmdLineOpts ( opt_PprStyle_Debug ) import StaticFlags( opt_PprStyle_Debug )
import Outputable import Outputable
import FastTypes import FastTypes
\end{code} \end{code}
......
...@@ -99,7 +99,8 @@ module CLabel ( ...@@ -99,7 +99,8 @@ module CLabel (
#include "HsVersions.h" #include "HsVersions.h"
import CmdLineOpts ( DynFlags, opt_Static, opt_DoTickyProfiling ) import DynFlags ( DynFlags )
import StaticFlags ( opt_Static, opt_DoTickyProfiling )
import Packages ( isHomeModule, isDllName ) import Packages ( isHomeModule, isDllName )
import DataCon ( ConTag ) import DataCon ( ConTag )
import Module ( moduleFS, Module ) import Module ( moduleFS, Module )
......
...@@ -37,7 +37,8 @@ import Literal ( mkMachInt ) ...@@ -37,7 +37,8 @@ import Literal ( mkMachInt )
import Unique import Unique
import UniqFM import UniqFM
import SrcLoc import SrcLoc
import CmdLineOpts ( DynFlags, DynFlag(..), opt_SccProfilingOn ) import DynFlags ( DynFlags, DynFlag(..) )
import StaticFlags ( opt_SccProfilingOn )
import ErrUtils ( printError, dumpIfSet_dyn, showPass ) import ErrUtils ( printError, dumpIfSet_dyn, showPass )
import StringBuffer ( hGetStringBuffer ) import StringBuffer ( hGetStringBuffer )
import FastString import FastString
......
...@@ -37,7 +37,7 @@ import UniqFM ( eltsUFM ) ...@@ -37,7 +37,7 @@ import UniqFM ( eltsUFM )
import FastString import FastString
import Outputable import Outputable
import Constants import Constants
import CmdLineOpts ( opt_EnsureSplittableC ) import StaticFlags ( opt_SplitObjs )
-- The rest -- The rest
import Data.List ( intersperse, groupBy ) import Data.List ( intersperse, groupBy )
...@@ -67,8 +67,8 @@ writeCs handle cmms = printForUser handle alwaysQualify (pprCs cmms) ...@@ -67,8 +67,8 @@ writeCs handle cmms = printForUser handle alwaysQualify (pprCs cmms)
-- ToDo: should be printForC -- ToDo: should be printForC
split_marker split_marker
| opt_EnsureSplittableC = ptext SLIT("__STG_SPLIT_MARKER") | opt_SplitObjs = ptext SLIT("__STG_SPLIT_MARKER")
| otherwise = empty | otherwise = empty
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Now do some real work -- Now do some real work
......
...@@ -58,7 +58,7 @@ import TyCon ( TyCon, tyConFamilySize ) ...@@ -58,7 +58,7 @@ import TyCon ( TyCon, tyConFamilySize )
import Bitmap ( Bitmap, mAX_SMALL_BITMAP_SIZE, import Bitmap ( Bitmap, mAX_SMALL_BITMAP_SIZE,
mkBitmap, intsToReverseBitmap ) mkBitmap, intsToReverseBitmap )
import Util ( isn'tIn, sortLe ) import Util ( isn'tIn, sortLe )
import CmdLineOpts ( opt_Unregisterised ) import StaticFlags ( opt_Unregisterised )
import FastString ( LitString ) import FastString ( LitString )
import Outputable import Outputable
import DATA_BITS import DATA_BITS
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgCase.lhs,v 1.72 2004/11/26 16:19:59 simonmar Exp $ % $Id: CgCase.lhs,v 1.73 2005/03/18 13:37:38 simonmar Exp $
% %
%******************************************************** %********************************************************
%* * %* *
...@@ -48,7 +48,7 @@ import CmmUtils ( CmmStmts, noStmts, oneStmt, plusStmts ) ...@@ -48,7 +48,7 @@ import CmmUtils ( CmmStmts, noStmts, oneStmt, plusStmts )
import Cmm import Cmm
import MachOp ( wordRep ) import MachOp ( wordRep )
import ClosureInfo ( mkLFArgument ) import ClosureInfo ( mkLFArgument )
import CmdLineOpts ( opt_SccProfilingOn ) import StaticFlags ( opt_SccProfilingOn )
import Id ( Id, idName, isDeadBinder, idType ) import Id ( Id, idName, isDeadBinder, idType )
import ForeignCall ( ForeignCall(..), CCallSpec(..), playSafe ) import ForeignCall ( ForeignCall(..), CCallSpec(..), playSafe )
import VarSet ( varSetElems ) import VarSet ( varSetElems )
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgClosure.lhs,v 1.66 2004/12/08 14:32:29 simonpj Exp $ % $Id: CgClosure.lhs,v 1.67 2005/03/18 13:37:40 simonmar Exp $
% %
\section[CgClosure]{Code generation for closures} \section[CgClosure]{Code generation for closures}
...@@ -42,7 +42,7 @@ import CmmUtils ( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts, ...@@ -42,7 +42,7 @@ import CmmUtils ( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts,
mkLblExpr ) mkLblExpr )
import CLabel import CLabel
import StgSyn import StgSyn
import CmdLineOpts ( opt_DoTickyProfiling ) import StaticFlags ( opt_DoTickyProfiling )
import CostCentre import CostCentre
import Id ( Id, idName, idType ) import Id ( Id, idName, idType )
import Name ( Name ) import Name ( Name )
......
...@@ -32,7 +32,7 @@ import MachOp ...@@ -32,7 +32,7 @@ import MachOp
import SMRep import SMRep
import ForeignCall import ForeignCall
import Constants import Constants
import CmdLineOpts ( opt_SccProfilingOn ) import StaticFlags ( opt_SccProfilingOn )
import Outputable import Outputable
import Monad ( when ) import Monad ( when )
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgHeapery.lhs,v 1.43 2005/02/10 13:01:53 simonmar Exp $ % $Id: CgHeapery.lhs,v 1.44 2005/03/18 13:37:42 simonmar Exp $
% %
\section[CgHeapery]{Heap management functions} \section[CgHeapery]{Heap management functions}
...@@ -53,7 +53,7 @@ import TyCon ( tyConPrimRep ) ...@@ -53,7 +53,7 @@ import TyCon ( tyConPrimRep )
import CostCentre ( CostCentreStack ) import CostCentre ( CostCentreStack )
import Util ( mapAccumL, filterOut ) import Util ( mapAccumL, filterOut )
import Constants ( wORD_SIZE ) import Constants ( wORD_SIZE )
import CmdLineOpts ( DynFlags ) import DynFlags ( DynFlags )
import Outputable import Outputable
import GLAEXTS import GLAEXTS
......
...@@ -57,7 +57,8 @@ import StgSyn ( SRT(..) ) ...@@ -57,7 +57,8 @@ import StgSyn ( SRT(..) )
import Name ( Name ) import Name ( Name )
import DataCon ( DataCon, dataConTag, fIRST_TAG ) import DataCon ( DataCon, dataConTag, fIRST_TAG )
import Unique ( Uniquable(..) ) import Unique ( Uniquable(..) )
import CmdLineOpts ( opt_SccProfilingOn, DynFlags(..), HscTarget(..) ) import DynFlags ( DynFlags(..), HscTarget(..) )
import StaticFlags ( opt_SccProfilingOn )
import ListSetOps ( assocDefault ) import ListSetOps ( assocDefault )
import Maybes ( isJust ) import Maybes ( isJust )
import Constants ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev ) import Constants ( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
......
% %
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
% %
% $Id: CgMonad.lhs,v 1.43 2004/12/08 14:32:31 simonpj Exp $ % $Id: CgMonad.lhs,v 1.44 2005/03/18 13:37:44 simonmar Exp $
% %
\section[CgMonad]{The code generation monad} \section[CgMonad]{The code generation monad}
...@@ -61,7 +61,7 @@ module CgMonad ( ...@@ -61,7 +61,7 @@ module CgMonad (
import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds ) import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
import CmdLineOpts ( DynFlags ) import DynFlags ( DynFlags )
import Cmm import Cmm
import CmmUtils ( CmmStmts, isNopStmt ) import CmmUtils ( CmmStmts, isNopStmt )
import CLabel import CLabel
......
...@@ -12,7 +12,7 @@ import CgMonad ...@@ -12,7 +12,7 @@ import CgMonad
import CgCallConv ( mkRegLiveness ) import CgCallConv ( mkRegLiveness )
import Id ( Id ) import Id ( Id )
import Cmm ( CmmLit, GlobalReg(..), node, CmmExpr ) import Cmm ( CmmLit, GlobalReg(..), node, CmmExpr )
import CmdLineOpts ( opt_GranMacros ) import StaticFlags ( opt_GranMacros )
import Outputable import Outputable
staticParHdr :: [CmmLit] staticParHdr :: [CmmLit]
......
...@@ -47,7 +47,7 @@ import Module ( moduleUserString ) ...@@ -47,7 +47,7 @@ import Module ( moduleUserString )
import Id ( Id ) import Id ( Id )
import CostCentre import CostCentre
import StgSyn ( GenStgExpr(..), StgExpr ) import StgSyn ( GenStgExpr(..), StgExpr )
import CmdLineOpts ( opt_SccProfilingOn ) import StaticFlags ( opt_SccProfilingOn )
import FastString ( FastString, mkFastString, LitString ) import FastString ( FastString, mkFastString, LitString )
import Constants -- Lots of field offsets import Constants -- Lots of field offsets
import Outputable import Outputable
......
...@@ -53,7 +53,7 @@ import CLabel ( CLabel, mkRtsDataLabel, mkRednCountsLabel ) ...@@ -53,7 +53,7 @@ import CLabel ( CLabel, mkRtsDataLabel, mkRednCountsLabel )
import Name ( isInternalName ) import Name ( isInternalName )
import Id ( Id, idType ) import Id ( Id, idType )
import CmdLineOpts ( opt_DoTickyProfiling ) import StaticFlags ( opt_DoTickyProfiling )
import BasicTypes ( Arity ) import BasicTypes ( Arity )
import FastString ( FastString, mkFastString, LitString ) import FastString ( FastString, mkFastString, LitString )
import Constants -- Lots of field offsets import Constants -- Lots of field offsets
......
...@@ -52,7 +52,7 @@ import CLabel ( CLabel, mkStringLitLabel ) ...@@ -52,7 +52,7 @@ import CLabel ( CLabel, mkStringLitLabel )
import Digraph ( SCC(..), stronglyConnComp ) import Digraph ( SCC(..), stronglyConnComp )
import ListSetOps ( assocDefault ) import ListSetOps ( assocDefault )
import Util ( filterOut, sortLe ) import Util ( filterOut, sortLe )
import CmdLineOpts ( DynFlags(..), HscTarget(..) ) import DynFlags ( DynFlags(..), HscTarget(..) )
import FastString ( LitString, FastString, unpackFS ) import FastString ( LitString, FastString, unpackFS )
import Outputable import Outputable
......
...@@ -63,7 +63,8 @@ import CLabel ...@@ -63,7 +63,8 @@ import CLabel
import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject ) import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
import Packages ( isDllName ) import Packages ( isDllName )
import CmdLineOpts ( DynFlags, opt_SccProfilingOn, opt_OmitBlackHoling, import DynFlags ( DynFlags )
import StaticFlags ( opt_SccProfilingOn, opt_OmitBlackHoling,
opt_Parallel, opt_DoTickyProfiling, opt_Parallel, opt_DoTickyProfiling,
opt_SMP ) opt_SMP )
import Id ( Id, idType, idArity, idName ) import Id ( Id, idType, idArity, idName )
......
...@@ -19,8 +19,6 @@ module CodeGen ( codeGen ) where ...@@ -19,8 +19,6 @@ module CodeGen ( codeGen ) where
#include "HsVersions.h" #include "HsVersions.h"
import DriverState ( v_Build_tag, v_MainModIs )
-- Kludge (??) so that CgExpr is reached via at least one non-SOURCE -- Kludge (??) so that CgExpr is reached via at least one non-SOURCE
-- import. Before, that wasn't the case, and CM therefore didn't -- import. Before, that wasn't the case, and CM therefore didn't
-- bother to compile it. -- bother to compile it.
...@@ -41,8 +39,8 @@ import MachOp ( wordRep, MachHint(..) ) ...@@ -41,8 +39,8 @@ import MachOp ( wordRep, MachHint(..) )
import StgSyn import StgSyn
import PrelNames ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER ) import PrelNames ( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
import CmdLineOpts ( DynFlags, DynFlag(..), opt_EnsureSplittableC, import DynFlags ( DynFlags(..), DynFlag(..) )
opt_SccProfilingOn ) import StaticFlags ( opt_SplitObjs, opt_SccProfilingOn )
import HscTypes ( ForeignStubs(..), TypeEnv, typeEnvTyCons ) import HscTypes ( ForeignStubs(..), TypeEnv, typeEnvTyCons )
import CostCentre ( CollectedCCs ) import CostCentre ( CollectedCCs )
...@@ -75,8 +73,8 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods ...@@ -75,8 +73,8 @@ codeGen dflags this_mod type_env foreign_stubs imported_mods
cost_centre_info stg_binds cost_centre_info stg_binds
= do = do
{ showPass dflags "CodeGen" { showPass dflags "CodeGen"
; way <- readIORef v_Build_tag ; let way = buildTag dflags
; mb_main_mod <- readIORef v_MainModIs mb_main_mod = mainModIs dflags
; let tycons = typeEnvTyCons type_env ; let tycons = typeEnvTyCons type_env
data_tycons = filter isDataTyCon tycons data_tycons = filter isDataTyCon tycons
...@@ -346,7 +344,7 @@ which refers to this name). ...@@ -346,7 +344,7 @@ which refers to this name).
\begin{code} \begin{code}
maybeExternaliseId :: Id -> FCode Id maybeExternaliseId :: Id -> FCode Id
maybeExternaliseId id maybeExternaliseId id
| opt_EnsureSplittableC, -- Externalise the name for -split-objs | opt_SplitObjs, -- Externalise the name for -split-objs
isInternalName name = do { mod <- moduleName isInternalName name = do { mod <- moduleName
; returnFC (setIdName id (externalise mod)) } ; returnFC (setIdName id (externalise mod)) }
| otherwise = returnFC id | otherwise = returnFC id
......
...@@ -42,7 +42,8 @@ import Id ( Id, idType ) ...@@ -42,7 +42,8 @@ import Id ( Id, idType )
import Type ( Type, typePrimRep, PrimRep(..) ) import Type ( Type, typePrimRep, PrimRep(..) )
import TyCon ( TyCon, tyConPrimRep ) import TyCon ( TyCon, tyConPrimRep )
import MachOp-- ( MachRep(..), MachHint(..), wordRep ) import MachOp-- ( MachRep(..), MachHint(..), wordRep )
import CmdLineOpts ( opt_SccProfilingOn, opt_GranMacros, opt_Unregisterised ) import StaticFlags ( opt_SccProfilingOn, opt_GranMacros,
opt_Unregisterised )
import Constants import Constants
import Outputable import Outputable
......
...@@ -10,7 +10,7 @@ module CompManager ( ...@@ -10,7 +10,7 @@ module CompManager (
CmState, -- Abstract CmState, -- Abstract
cmInit, -- :: GhciMode -> IO CmState cmInit, -- :: GhcMode -> IO CmState
cmDepAnal, -- :: CmState -> [FilePath] -> IO ModuleGraph cmDepAnal, -- :: CmState -> [FilePath] -> IO ModuleGraph
cmDownsweep, cmDownsweep,
...@@ -58,19 +58,18 @@ where ...@@ -58,19 +58,18 @@ where
import Packages ( isHomePackage ) import Packages ( isHomePackage )
import DriverPipeline ( CompResult(..), preprocess, compile, link ) import DriverPipeline ( CompResult(..), preprocess, compile, link )
import HscMain ( newHscEnv ) import HscMain ( newHscEnv )
import DriverState ( v_Output_file, v_NoHsMain, v_MainModIs )
import DriverPhases ( HscSource(..), hscSourceString, isHaskellSrcFilename ) import DriverPhases ( HscSource(..), hscSourceString, isHaskellSrcFilename )
import Finder ( findModule, findLinkable, addHomeModuleToFinder, import Finder ( findModule, findLinkable, addHomeModuleToFinder,
flushFinderCache, mkHomeModLocation, FindResult(..), cantFindError ) flushFinderCache, mkHomeModLocation, FindResult(..), cantFindError )
import HscTypes ( ModSummary(..), HomeModInfo(..), ModIface(..), msHsFilePath, import HscTypes ( ModSummary(..), HomeModInfo(..), ModIface(..),
HscEnv(..), GhciMode(..), isBootSummary, msHsFilePath, HscEnv(..), isBootSummary,
InteractiveContext(..), emptyInteractiveContext, InteractiveContext(..), emptyInteractiveContext,
HomePackageTable, emptyHomePackageTable, IsBootInterface, HomePackageTable, emptyHomePackageTable,
Linkable(..), isObjectLinkable ) IsBootInterface, Linkable(..), isObjectLinkable )
import Module ( Module, mkModule, delModuleEnv, delModuleEnvList, mkModuleEnv, import Module ( Module, mkModule, delModuleEnv, delModuleEnvList,
lookupModuleEnv, moduleEnvElts, extendModuleEnv, filterModuleEnv, mkModuleEnv, lookupModuleEnv, moduleEnvElts,
moduleUserString, addBootSuffixLocn, extendModuleEnv, filterModuleEnv, moduleUserString,
ModLocation(..) ) addBootSuffixLocn, ModLocation(..) )
import GetImports ( getImports ) import GetImports ( getImports )
import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs ) import Digraph ( SCC(..), stronglyConnComp, flattenSCC, flattenSCCs )
import ErrUtils ( showPass ) import ErrUtils ( showPass )
...@@ -80,12 +79,10 @@ import StringBuffer ( hGetStringBuffer ) ...@@ -80,12 +79,10 @@ import StringBuffer ( hGetStringBuffer )
import Util import Util
import Outputable import Outputable
import Panic import Panic
import CmdLineOpts ( DynFlags(..) ) import DynFlags ( DynFlags(..), DynFlag(..), GhcMode(..), dopt )
import Maybes ( expectJust, orElse, mapCatMaybes ) import Maybes ( expectJust, orElse, mapCatMaybes )
import FiniteMap import FiniteMap
import DATA_IOREF ( readIORef )
#ifdef GHCI #ifdef GHCI
import Finder ( findPackageModule ) import Finder ( findPackageModule )
import HscMain ( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType ) import HscMain ( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType )
...@@ -102,7 +99,7 @@ import Linker ( HValue, unload, extendLinkEnv ) ...@@ -102,7 +99,7 @@ import Linker ( HValue, unload, extendLinkEnv )
import GHC.Exts ( unsafeCoerce# ) import GHC.Exts ( unsafeCoerce# )
import Foreign import Foreign
import Control.Exception as Exception ( Exception, try ) import Control.Exception as Exception ( Exception, try )
import CmdLineOpts ( DynFlag(..), dopt_unset, dopt ) import DynFlags ( DynFlag(..), dopt_unset, dopt )
#endif #endif
import EXCEPTION ( throwDyn ) import EXCEPTION ( throwDyn )
...@@ -183,9 +180,9 @@ cmGetPrintUnqual cmstate = icPrintUnqual (cm_ic cmstate) ...@@ -183,9 +180,9 @@ cmGetPrintUnqual cmstate = icPrintUnqual (cm_ic cmstate)
cmHPT cmstate = hsc_HPT (cm_hsc cmstate) cmHPT cmstate = hsc_HPT (cm_hsc cmstate)
#endif #endif
cmInit :: GhciMode -> DynFlags -> IO CmState cmInit :: DynFlags -> IO CmState
cmInit ghci_mode dflags cmInit dflags
= do { hsc_env <- newHscEnv ghci_mode dflags = do { hsc_env <- newHscEnv dflags
; return (CmState { cm_hsc = hsc_env, ; return (CmState { cm_hsc = hsc_env,
cm_mg = emptyMG, cm_mg = emptyMG,
cm_ic = emptyInteractiveContext })} cm_ic = emptyInteractiveContext })}
...@@ -499,8 +496,8 @@ cmUnload state@CmState{ cm_hsc = hsc_env } ...@@ -499,8 +496,8 @@ cmUnload state@CmState{ cm_hsc = hsc_env }
return (discardCMInfo state) return (discardCMInfo state)
cm_unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables' cm_unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
= case hsc_mode hsc_env of = case ghcMode (hsc_dflags hsc_env) of
Batch -> return () BatchCompile -> return ()
#ifdef GHCI #ifdef GHCI
Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
#else #else
...@@ -523,7 +520,7 @@ cm_unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkable ...@@ -523,7 +520,7 @@ cm_unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkable
cmDepAnal :: CmState -> [FilePath] -> IO ModuleGraph cmDepAnal :: CmState -> [FilePath] -> IO ModuleGraph
cmDepAnal cmstate rootnames cmDepAnal cmstate rootnames
= do showPass dflags "Chasing dependencies" = do showPass dflags "Chasing dependencies"
when (verbosity dflags >= 1 && gmode == Batch) $ when (verbosity dflags >= 1 && gmode == BatchCompile) $
hPutStrLn stderr (showSDoc (hcat [ hPutStrLn stderr (showSDoc (hcat [
text "Chasing modules from: ", text "Chasing modules from: ",
hcat (punctuate comma (map text rootnames))])) hcat (punctuate comma (map text rootnames))]))
...@@ -531,7 +528,7 @@ cmDepAnal cmstate rootnames ...@@ -531,7 +528,7 @@ cmDepAnal cmstate rootnames
where where
hsc_env = cm_hsc cmstate hsc_env = cm_hsc cmstate
dflags = hsc_dflags hsc_env dflags = hsc_dflags hsc_env
gmode = hsc_mode hsc_env gmode = ghcMode (hsc_dflags hsc_env)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- The real business of the compilation manager: given a system state and -- The real business of the compilation manager: given a system state and
...@@ -548,7 +545,7 @@ cmLoadModules cmstate1 mg2unsorted ...@@ -548,7 +545,7 @@ cmLoadModules cmstate1 mg2unsorted
= do -- version 1's are the original, before downsweep = do -- version 1's are the original, before downsweep
let hsc_env = cm_hsc cmstate1 let hsc_env = cm_hsc cmstate1
let hpt1 = hsc_HPT hsc_env let hpt1 = hsc_HPT hsc_env
let ghci_mode = hsc_mode hsc_env -- this never changes let ghci_mode = ghcMode (hsc_dflags hsc_env) -- this never changes
let dflags = hsc_dflags hsc_env -- this never changes let dflags = hsc_dflags hsc_env -- this never changes
let verb = verbosity dflags let verb = verbosity dflags
...@@ -676,16 +673,15 @@ cmLoadModules cmstate1 mg2unsorted ...@@ -676,16 +673,15 @@ cmLoadModules cmstate1 mg2unsorted
-- Clean up after ourselves -- Clean up after ourselves
cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone) cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
-- Issue a warning for the confusing case where the user -- Issue a warning for the confusing case where the user
-- said '-o foo' but we're not going to do any linking. -- said '-o foo' but we're not going to do any linking.
-- We attempt linking if either (a) one of the modules is -- We attempt linking if either (a) one of the modules is
-- called Main, or (b) the user said -no-hs-main, indicating -- called Main, or (b) the user said -no-hs-main, indicating
-- that main() is going to come from somewhere else. -- that main() is going to come from somewhere else.
-- --
ofile <- readIORef v_Output_file let ofile = outputFile dflags
no_hs_main <- readIORef v_NoHsMain let no_hs_main = dopt Opt_NoHsMain dflags
mb_main_mod <- readIORef v_MainModIs let mb_main_mod = mainModIs dflags
let let
main_mod = mb_main_mod `orElse` "Main" main_mod = mb_main_mod `orElse` "Main"
a_root_is_Main a_root_is_Main
...@@ -693,7 +689,7 @@ cmLoadModules cmstate1 mg2unsorted ...@@ -693,7 +689,7 @@ cmLoadModules cmstate1 mg2unsorted
mg2unsorted mg2unsorted
do_linking = a_root_is_Main || no_hs_main do_linking = a_root_is_Main || no_hs_main
when (ghci_mode == Batch && isJust ofile && not do_linking when (ghci_mode == BatchCompile && isJust ofile && not do_linking
&& verb > 0) $ && verb > 0) $
hPutStrLn stderr ("Warning: output was redirected with -o, " ++ hPutStrLn stderr ("Warning: output was redirected with -o, " ++
"but no output will be generated\n" ++ "but no output will be generated\n" ++
...@@ -778,7 +774,7 @@ ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ] ...@@ -778,7 +774,7 @@ ppFilesFromSummaries summaries = [ fn | Just fn <- map ms_hspp_file summaries ]
-- ToDo: this pass could be merged with the preUpsweep. -- ToDo: this pass could be merged with the preUpsweep.
getValidLinkables getValidLinkables
:: GhciMode :: GhcMode
-> [Linkable] -- old linkables -> [Linkable] -- old linkables
-> [Module] -- all home modules -> [Module] -- all home modules
-> [SCC ModSummary] -- all modules in the program, dependency order