Commit abbc5a0b authored by simonmar's avatar simonmar
Browse files

[project @ 2003-09-23 14:32:57 by simonmar]

- Convert many of the optimisation options into dynamic options (that is,
  they can be mentioned in {-# OPTIONS #-} pragmas).

- Add a new way to specify constructor-field unboxing on a selective
  basis.  To tell the compiler to unbox a constructor field, do this:

      data T = T !!Int

  and GHC will store that field unboxed if possible.  If it isn't possible
  (say, because the field has a sum type) then the annotation is ignored.

  The -funbox-strict-fields flag is now a dynamic flag, and has the same
  effect as replacing all the '!' annotations with '!!'.
parent 7256d590
......@@ -402,6 +402,7 @@ e.g. data T = MkT !Int !(Bool,Bool)
\begin{code}
data StrictnessMark
= MarkedUserStrict -- "!" in a source decl
| MarkedUserUnboxed -- "!!" in a source decl
| MarkedStrict -- "!" in an interface decl: strict but not unboxed
| MarkedUnboxed -- "!!" in an interface decl: unboxed
| NotMarkedStrict -- No annotation at all
......
......@@ -41,7 +41,6 @@ import FieldLabel ( FieldLabel )
import BasicTypes ( Arity, StrictnessMark(..) )
import Outputable
import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
import Maybes ( orElse )
import ListSetOps ( assoc )
import Util ( zipEqual, zipWithEqual, notNull )
......@@ -555,12 +554,13 @@ chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
-- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
chooseBoxingStrategy tycon arg_ty strict
= case strict of
MarkedUserStrict
| opt_UnboxStrictFields
&& unbox arg_ty -> MarkedUnboxed
MarkedUserStrict -> MarkedStrict
MarkedUserUnboxed
| can_unbox -> MarkedUnboxed
| otherwise -> MarkedStrict
other -> strict
where
can_unbox = unbox arg_ty
-- beware: repType will go into a loop if we try this on a recursive
-- type (for reasons unknown...), hence the check for recursion below.
unbox ty =
......
......@@ -22,7 +22,7 @@ import CoreSyn
import DsMonad -- the monadery used in the desugarer
import DsUtils
import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_RulesOff )
import CmdLineOpts ( DynFlag(..), dopt, opt_RulesOff )
import CoreUtils ( exprType, mkIfThenElse )
import Id ( idType )
import Var ( Id )
......@@ -51,17 +51,19 @@ dsListComp :: [TypecheckedStmt]
-> DsM CoreExpr
dsListComp quals elt_ty
| opt_RulesOff || opt_IgnoreIfacePragmas -- Either rules are switched off, or
-- we are ignoring what there are;
-- Either way foldr/build won't happen, so
-- use the more efficient Wadler-style desugaring
|| isParallelComp quals -- Foldr-style desugaring can't handle
-- parallel list comprehensions
= deListComp quals (mkNilExpr elt_ty)
| otherwise -- Foldr/build should be enabled, so desugar
-- into foldrs and builds
= newTyVarsDs [alphaTyVar] `thenDs` \ [n_tyvar] ->
= getDOptsDs `thenDs` \dflags ->
if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
-- Either rules are switched off, or we are ignoring what there are;
-- Either way foldr/build won't happen, so use the more efficient
-- Wadler-style desugaring
|| isParallelComp quals
-- Foldr-style desugaring can't handle
-- parallel list comprehensions
then deListComp quals (mkNilExpr elt_ty)
else -- Foldr/build should be enabled, so desugar
-- into foldrs and builds
newTyVarsDs [alphaTyVar] `thenDs` \ [n_tyvar] ->
let
n_ty = mkTyVarTy n_tyvar
c_ty = mkFunTys [elt_ty, n_ty] n_ty
......
......@@ -113,7 +113,7 @@ dsReify (ReifyOut ReifyType name)
dsReify r@(ReifyOut ReifyDecl name)
= do { thing <- dsLookupGlobal name ;
mb_d <- repTyClD (ifaceTyThing thing) ;
mb_d <- repTyClD (ifaceTyThing True{-omit pragmas-} thing) ;
case mb_d of
Just (MkC d) -> return d
Nothing -> pprPanic "dsReify" (ppr r)
......
{-# OPTIONS -#include "Linker.h" #-}
-----------------------------------------------------------------------------
-- $Id: InteractiveUI.hs,v 1.159 2003/09/04 11:08:46 simonmar Exp $
-- $Id: InteractiveUI.hs,v 1.160 2003/09/23 14:32:58 simonmar Exp $
--
-- GHC Interactive User Interface
--
......@@ -492,7 +492,7 @@ info s = do
showThing (ty_thing, fixity)
= vcat [ text "-- " <> showTyThing ty_thing,
showFixity fixity (getName ty_thing),
ppr (ifaceTyThing ty_thing) ]
ppr (ifaceTyThing True{-omit prags-} ty_thing) ]
showFixity fix name
| fix == defaultFixity = empty
......@@ -723,10 +723,10 @@ browseModule m exports_only = do
thing_names = map getName things
thingDecl thing@(AnId id) = ifaceTyThing thing
thingDecl thing@(AnId id) = ifaceTyThing True{-omit prags-} thing
thingDecl thing@(AClass c) =
let rn_decl = ifaceTyThing thing in
let rn_decl = ifaceTyThing True{-omit prags-} thing in
case rn_decl of
ClassDecl { tcdSigs = cons } ->
rn_decl{ tcdSigs = filter methodIsVisible cons }
......@@ -735,7 +735,7 @@ browseModule m exports_only = do
methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names
thingDecl thing@(ATyCon t) =
let rn_decl = ifaceTyThing thing in
let rn_decl = ifaceTyThing True{-omit prags-} thing in
case rn_decl of
TyData { tcdCons = DataCons cons } ->
rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
......@@ -747,8 +747,6 @@ browseModule m exports_only = do
vcat (map (ppr . thingDecl) things')))
)
where
-----------------------------------------------------------------------------
-- Setting the module context
......@@ -963,7 +961,7 @@ showBindings = do
cms <- getCmState
let
unqual = cmGetPrintUnqual cms
showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing b)))
showBinding b = putStrLn (showSDocForUser unqual (ppr (ifaceTyThing True{-omit prags-} b)))
io (mapM_ showBinding (cmGetBindings cms))
return ()
......
......@@ -28,7 +28,7 @@ import Module ( moduleName )
import OccName ( OccName )
import RnHsSyn
import DriverState ( v_Build_tag )
import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_HiVersion )
import CmdLineOpts ( opt_HiVersion )
import Panic
import SrcLoc
import Binary
......@@ -170,9 +170,7 @@ instance (Binary name) => Binary (TyClDecl name) where
name <- get bh
ty <- lazyGet bh
idinfo <- lazyGet bh
let idinfo' | opt_IgnoreIfacePragmas = []
| otherwise = idinfo
return (IfaceSig name ty idinfo' noSrcLoc)
return (IfaceSig name ty idinfo noSrcLoc)
1 -> error "Binary.get(TyClDecl): ForeignType"
2 -> do
n_or_d <- get bh
......
......@@ -6,7 +6,7 @@
\begin{code}
module CmdLineOpts (
CoreToDo(..), StgToDo(..),
CoreToDo(..), buildCoreToDo, StgToDo(..),
SimplifierSwitch(..),
SimplifierMode(..), FloatOutSwitches(..),
......@@ -30,6 +30,7 @@ module CmdLineOpts (
getOpts, -- (DynFlags -> [a]) -> IO [a]
setLang,
getVerbFlag,
setOptLevel,
-- Manipulating the DynFlags state
getDynFlags, -- IO DynFlags
......@@ -74,14 +75,9 @@ module CmdLineOpts (
opt_NoMethodSharing,
opt_DoSemiTagging,
opt_LiberateCaseThreshold,
opt_StgDoLetNoEscapes,
opt_CprOff,
opt_RulesOff,
opt_UnboxStrictFields,
opt_SimplNoPreInlining,
opt_SimplDoEtaReduction,
opt_SimplDoLambdaEtaExpansion,
opt_SimplCaseMerge,
opt_SimplExcessPrecision,
opt_MaxWorkerArgs,
......@@ -101,11 +97,8 @@ module CmdLineOpts (
opt_GranMacros,
opt_HiVersion,
opt_HistorySize,
opt_IgnoreAsserts,
opt_IgnoreIfacePragmas,
opt_NoHiCheck,
opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
opt_NoPruneDecls,
opt_Static,
opt_Unregisterised,
......@@ -297,10 +290,21 @@ data DynFlag
| Opt_Generics
| Opt_NoImplicitPrelude
-- optimisation opts
| Opt_Strictness
| Opt_CSE
| Opt_IgnoreInterfacePragmas
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
deriving (Eq)
data DynFlags = DynFlags {
coreToDo :: [CoreToDo],
coreToDo :: Maybe [CoreToDo], -- reserved for use with -Ofile
stgToDo :: [StgToDo],
hscLang :: HscLang,
hscOutName :: String, -- name of the output file
......@@ -308,6 +312,9 @@ data DynFlags = DynFlags {
hscStubCOutName :: String, -- name of the .stub_c output file
extCoreName :: String, -- name of the .core output file
verbosity :: Int, -- verbosity level
optLevel :: Int, -- optimisation level
maxSimplIterations :: Int, -- max simplifier iterations
ruleCheck :: Maybe String,
cppFlag :: Bool, -- preprocess with cpp?
ppFlag :: Bool, -- preprocess with a Haskell Pp?
stolen_x86_regs :: Int,
......@@ -346,12 +353,15 @@ defaultHscLang
| otherwise = HscC
defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [],
coreToDo = Nothing, stgToDo = [],
hscLang = defaultHscLang,
hscOutName = "",
hscStubHOutName = "", hscStubCOutName = "",
extCoreName = "",
verbosity = 0,
verbosity = 0,
optLevel = 0,
maxSimplIterations = 4,
ruleCheck = Nothing,
cppFlag = False,
ppFlag = False,
stolen_x86_regs = 4,
......@@ -366,9 +376,21 @@ defaultDynFlags = DynFlags {
opt_I = [],
opt_i = [],
#endif
flags = [Opt_Generics] ++ standardWarnings,
-- Generating the helper-functions for
-- generics is now on by default
flags = [
Opt_Generics,
-- Generating the helper-functions for
-- generics is now on by default
Opt_Strictness,
-- strictness is on by default, but this only
-- applies to -O.
Opt_CSE,
-- similarly for CSE.
Opt_DoLambdaEtaExpansion
-- This one is important for a tiresome reason:
-- we want to make sure that the bindings for data
-- constructors are eta-expanded. This is probably
-- a good thing anyway, but it seems fragile.
] ++ standardWarnings,
}
{-
......@@ -385,7 +407,7 @@ defaultDynFlags = DynFlags {
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags)
dopt_CoreToDo :: DynFlags -> [CoreToDo]
dopt_CoreToDo :: DynFlags -> Maybe [CoreToDo]
dopt_CoreToDo = coreToDo
dopt_StgToDo :: DynFlags -> [StgToDo]
......@@ -418,9 +440,173 @@ setLang l = updDynFlags (\ dfs -> case hscLang dfs of
getVerbFlag = do
verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return ""
\end{code}
-----------------------------------------------------------------------------
-- Setting the optimisation level
setOptLevel :: Int -> IO ()
setOptLevel n
= do dflags <- getDynFlags
if hscLang dflags == HscInterpreted && n > 0
then putStr "warning: -O conflicts with --interactive; -O ignored.\n"
else updDynFlags (setOptLevel' n)
setOptLevel' n dfs
= if (n >= 1)
then dfs2{ hscLang = HscC, optLevel = n } -- turn on -fvia-C with -O
else dfs2{ optLevel = n }
where
dfs1 = foldr (flip dopt_unset) dfs remove_dopts
dfs2 = foldr (flip dopt_set) dfs1 extra_dopts
extra_dopts
| n == 0 = opt_0_dopts
| otherwise = opt_1_dopts
remove_dopts
| n == 0 = opt_1_dopts
| otherwise = opt_0_dopts
opt_0_dopts = [
Opt_IgnoreInterfacePragmas,
Opt_OmitInterfacePragmas
]
opt_1_dopts = [
Opt_IgnoreAsserts,
Opt_DoEtaReduction,
Opt_CaseMerge
]
-- Core-to-core phases:
buildCoreToDo :: DynFlags -> [CoreToDo]
buildCoreToDo dflags = core_todo
where
opt_level = optLevel dflags
max_iter = maxSimplIterations dflags
strictness = dopt Opt_Strictness dflags
cse = dopt Opt_CSE dflags
rule_check = ruleCheck dflags
core_todo =
if opt_level == 0 then
[
CoreDoSimplify (SimplPhase 0) [
MaxSimplifierIterations max_iter
]
]
else {- opt_level >= 1 -} [
-- initial simplify: mk specialiser happy: minimum effort please
CoreDoSimplify SimplGently [
-- Simplify "gently"
-- Don't inline anything till full laziness has bitten
-- In particular, inlining wrappers inhibits floating
-- e.g. ...(case f x of ...)...
-- ==> ...(case (case x of I# x# -> fw x#) of ...)...
-- ==> ...(case x of I# x# -> case fw x# of ...)...
-- and now the redex (f x) isn't floatable any more
-- Similarly, don't apply any rules until after full
-- laziness. Notably, list fusion can prevent floating.
NoCaseOfCase,
-- Don't do case-of-case transformations.
-- This makes full laziness work better
MaxSimplifierIterations max_iter
],
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
CoreDoSpecialising,
CoreDoFloatOutwards (FloatOutSw False False),
CoreDoFloatInwards,
CoreDoSimplify (SimplPhase 2) [
-- Want to run with inline phase 2 after the specialiser to give
-- maximum chance for fusion to work before we inline build/augment
-- in phase 1. This made a difference in 'ansi' where an
-- overloaded function wasn't inlined till too late.
MaxSimplifierIterations max_iter
],
case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
CoreDoSimplify (SimplPhase 1) [
-- Need inline-phase2 here so that build/augment get
-- inlined. I found that spectral/hartel/genfft lost some useful
-- strictness in the function sumcode' if augment is not inlined
-- before strictness analysis runs
MaxSimplifierIterations max_iter
],
case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
CoreDoSimplify (SimplPhase 0) [
-- Phase 0: allow all Ids to be inlined now
-- This gets foldr inlined before strictness analysis
MaxSimplifierIterations 3
-- At least 3 iterations because otherwise we land up with
-- huge dead expressions because of an infelicity in the
-- simpifier.
-- let k = BIG in foldr k z xs
-- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-- Don't stop now!
],
case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
#ifdef OLD_STRICTNESS
CoreDoOldStrictness
#endif
if strictness then CoreDoStrictness else CoreDoNothing,
CoreDoWorkerWrapper,
CoreDoGlomBinds,
CoreDoSimplify (SimplPhase 0) [
MaxSimplifierIterations max_iter
],
CoreDoFloatOutwards (FloatOutSw False -- Not lambdas
True), -- Float constants
-- nofib/spectral/hartel/wang doubles in speed if you
-- do full laziness late in the day. It only happens
-- after fusion and other stuff, so the early pass doesn't
-- catch it. For the record, the redex is
-- f_el22 (f_el21 r_midblock)
-- We want CSE to follow the final full-laziness pass, because it may
-- succeed in commoning up things floated out by full laziness.
-- CSE used to rely on the no-shadowing invariant, but it doesn't any more
if cse then CoreCSE else CoreDoNothing,
CoreDoFloatInwards,
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
if opt_level >= 2 then
CoreLiberateCase
else
CoreDoNothing,
if opt_level >= 2 then
CoreDoSpecConstr
else
CoreDoNothing,
-- Final clean-up simplification:
CoreDoSimplify (SimplPhase 0) [
MaxSimplifierIterations max_iter
]
]
-- --------------------------------------------------------------------------
-- Mess about with the mutable variables holding the dynamic arguments
-- v_InitDynFlags
......@@ -433,7 +619,6 @@ getVerbFlag = do
-- to the value of v_InitDynFlags before each compilation, then
-- updated by reading any OPTIONS pragma in the current module.
\begin{code}
GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
......@@ -590,8 +775,6 @@ opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off")
-- Switch off CPR analysis in the new demand analyser
opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
opt_StgDoLetNoEscapes = lookUp FSLIT("-flet-no-escape")
opt_UnboxStrictFields = lookUp FSLIT("-funbox-strict-fields")
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
{-
......@@ -608,20 +791,14 @@ opt_EnsureSplittableC = lookUp FSLIT("-fglobalise-toplev-names")
opt_GranMacros = lookUp FSLIT("-fgransim")
opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
opt_HistorySize = lookup_def_int "-fhistory-size" 20
opt_IgnoreAsserts = lookUp FSLIT("-fignore-asserts")
opt_IgnoreIfacePragmas = lookUp FSLIT("-fignore-interface-pragmas")
opt_NoHiCheck = lookUp FSLIT("-fno-hi-version-check")
opt_OmitBlackHoling = lookUp FSLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp FSLIT("-fomit-interface-pragmas")
opt_RuntimeTypes = lookUp FSLIT("-fruntime-types")
-- Simplifier switches
opt_SimplNoPreInlining = lookUp FSLIT("-fno-pre-inlining")
-- NoPreInlining is there just to see how bad things
-- get if you don't do it!
opt_SimplDoEtaReduction = lookUp FSLIT("-fdo-eta-reduction")
opt_SimplDoLambdaEtaExpansion = lookUp FSLIT("-fdo-lambda-eta-expansion")
opt_SimplCaseMerge = lookUp FSLIT("-fcase-merge")
opt_SimplExcessPrecision = lookUp FSLIT("-fexcess-precision")
-- Unfolding control
......@@ -664,21 +841,14 @@ isStaticHscFlag f =
"fflatten",
"fsemi-tagging",
"flet-no-escape",
"funbox-strict-fields",
"femit-extern-decls",
"fglobalise-toplev-names",
"fgransim",
"fignore-asserts",
"fignore-interface-pragmas",
"fno-hi-version-check",
"dno-black-holing",
"fno-method-sharing",
"fomit-interface-pragmas",
"fruntime-types",
"fno-pre-inlining",
"fdo-eta-reduction",
"fdo-lambda-eta-expansion",
"fcase-merge",
"fexcess-precision",
"funfolding-update-in-place",
"fno-prune-decls",
......
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.124 2003/09/10 16:44:05 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.125 2003/09/23 14:32:59 simonmar Exp $
--
-- Driver flags
--
......@@ -307,28 +307,11 @@ static_flags =
, ( "Rghc-timing" , NoArg (enableTimingStats) )
------ Compiler flags -----------------------------------------------
, ( "O2-for-C" , NoArg (writeIORef v_minus_o2_for_C True) )
, ( "O" , NoArg (setOptLevel 1))
, ( "Onot" , NoArg (setOptLevel 0))
, ( "O" , PrefixPred (all isDigit) (setOptLevel . read))
, ( "fno-asm-mangling" , NoArg (writeIORef v_Do_asm_mangling False) )
, ( "fmax-simplifier-iterations",
PrefixPred (all isDigit) (writeIORef v_MaxSimplifierIterations . read) )
, ( "frule-check",
SepArg (\s -> writeIORef v_RuleCheck (Just s)) )
, ( "fexcess-precision" , NoArg (do writeIORef v_Excess_precision True
add v_Opt_C "-fexcess-precision"))
-- Optimisation flags are treated specially, so the normal
-- -fno-* pattern below doesn't work. We therefore allow
-- certain optimisation passes to be turned off explicitly:
, ( "fno-strictness" , NoArg (writeIORef v_Strictness False) )
, ( "fno-cse" , NoArg (writeIORef v_CSE False) )
-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
, ( "fno-", PrefixPred (\s -> isStaticHscFlag ("f"++s))
(\s -> add v_Anti_opt_C ("-f"++s)) )
......@@ -417,6 +400,19 @@ dynamic_flags = [
, ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
, ( "w" , NoArg (mapM_ unSetDynFlag minusWallOpts) )
------ Optimisation flags ------------------------------------------
, ( "O" , NoArg (setOptLevel 1))
, ( "Onot" , NoArg (setOptLevel 0))
, ( "O" , PrefixPred (all isDigit) (setOptLevel . read))
, ( "fmax-simplifier-iterations",
PrefixPred (all isDigit)
(\n -> updDynFlags (\dfs ->
dfs{ maxSimplIterations = read n })) )
, ( "frule-check",
SepArg (\s -> updDynFlags (\dfs -> dfs{ ruleCheck = Just s })))
------ Compiler flags -----------------------------------------------
, ( "fasm", AnySuffix (\_ -> setLang HscAsm) )
......@@ -464,7 +460,16 @@ fFlags = [
( "allow-overlapping-instances", Opt_AllowOverlappingInstances ),
( "allow-undecidable-instances", Opt_AllowUndecidableInstances ),
( "allow-incoherent-instances", Opt_AllowIncoherentInstances ),
( "generics", Opt_Generics )
( "generics", Opt_Generics ),
( "strictness", Opt_Strictness ),
( "cse", Opt_CSE ),
( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ),
( "omit-interface-pragmas", Opt_OmitInterfacePragmas ),
( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ),
( "ignore-asserts", Opt_IgnoreAsserts ),
( "do-eta-reduction", Opt_DoEtaReduction ),
( "case-merge", Opt_CaseMerge ),
( "unbox-strict-fields", Opt_UnboxStrictFields )
]
glasgowExtsFlags = [ Opt_GlasgowExts, Opt_FFI, Opt_TH, Opt_ImplicitParams ]
......@@ -506,21 +511,10 @@ buildStaticHscOpts = do
opt_C_ <- getStaticOpts v_Opt_C -- misc hsc opts from the command line
-- optimisation
minus_o <- readIORef v_OptLevel
let optimisation_opts =
case minus_o of
0 -> hsc_minusNoO_flags
1 -> hsc_minusO_flags
2 -> hsc_minusO2_flags
n -> throwDyn (CmdLineError ("unknown optimisation level: "
++ show n))
-- ToDo: -Ofile
-- take into account -fno-* flags by removing the equivalent -f*
-- flag from our list.
anti_flags <- getStaticOpts v_Anti_opt_C
let basic_opts = opt_C_ ++ optimisation_opts
let basic_opts = opt_C_
filtered_opts = filter (`notElem` anti_flags) basic_opts
static <- (do s <- readIORef v_Static; if s then return "-static"
......
......@@ -690,10 +690,6 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
verb <- getVerbFlag
o2 <- readIORef v_minus_o2_for_C
let opt_flag | o2 = "-O2"
| otherwise = "-O"
pkg_extra_cc_opts <- getPackageExtraCcOpts pkgs
split_objs <- readIORef v_Split_object_files
......@@ -718,7 +714,7 @@ runPhase cc_phase basename suff input_fn get_output_fn maybe_loc
++ (if cc_phase == HCc && mangle
then md_regd_c_flags
else [])
++ [ verb, "-S", "-Wimplicit", opt_flag ]
++ [ verb, "-S", "-Wimplicit", "-O" ]