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) ...@@ -402,6 +402,7 @@ e.g. data T = MkT !Int !(Bool,Bool)
\begin{code} \begin{code}
data StrictnessMark data StrictnessMark
= MarkedUserStrict -- "!" in a source decl = MarkedUserStrict -- "!" in a source decl
| MarkedUserUnboxed -- "!!" in a source decl
| MarkedStrict -- "!" in an interface decl: strict but not unboxed | MarkedStrict -- "!" in an interface decl: strict but not unboxed
| MarkedUnboxed -- "!!" in an interface decl: unboxed | MarkedUnboxed -- "!!" in an interface decl: unboxed
| NotMarkedStrict -- No annotation at all | NotMarkedStrict -- No annotation at all
......
...@@ -41,7 +41,6 @@ import FieldLabel ( FieldLabel ) ...@@ -41,7 +41,6 @@ import FieldLabel ( FieldLabel )
import BasicTypes ( Arity, StrictnessMark(..) ) import BasicTypes ( Arity, StrictnessMark(..) )
import Outputable import Outputable
import Unique ( Unique, Uniquable(..) ) import Unique ( Unique, Uniquable(..) )
import CmdLineOpts ( opt_UnboxStrictFields )
import Maybes ( orElse ) import Maybes ( orElse )
import ListSetOps ( assoc ) import ListSetOps ( assoc )
import Util ( zipEqual, zipWithEqual, notNull ) import Util ( zipEqual, zipWithEqual, notNull )
...@@ -555,12 +554,13 @@ chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark ...@@ -555,12 +554,13 @@ chooseBoxingStrategy :: TyCon -> Type -> StrictnessMark -> StrictnessMark
-- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict -- Transforms any MarkedUserStricts into MarkUnboxed or MarkedStrict
chooseBoxingStrategy tycon arg_ty strict chooseBoxingStrategy tycon arg_ty strict
= case strict of = case strict of
MarkedUserStrict MarkedUserStrict -> MarkedStrict
| opt_UnboxStrictFields MarkedUserUnboxed
&& unbox arg_ty -> MarkedUnboxed | can_unbox -> MarkedUnboxed
| otherwise -> MarkedStrict | otherwise -> MarkedStrict
other -> strict other -> strict
where where
can_unbox = unbox arg_ty
-- beware: repType will go into a loop if we try this on a recursive -- beware: repType will go into a loop if we try this on a recursive
-- type (for reasons unknown...), hence the check for recursion below. -- type (for reasons unknown...), hence the check for recursion below.
unbox ty = unbox ty =
......
...@@ -22,7 +22,7 @@ import CoreSyn ...@@ -22,7 +22,7 @@ import CoreSyn
import DsMonad -- the monadery used in the desugarer import DsMonad -- the monadery used in the desugarer
import DsUtils import DsUtils
import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_RulesOff ) import CmdLineOpts ( DynFlag(..), dopt, opt_RulesOff )
import CoreUtils ( exprType, mkIfThenElse ) import CoreUtils ( exprType, mkIfThenElse )
import Id ( idType ) import Id ( idType )
import Var ( Id ) import Var ( Id )
...@@ -51,17 +51,19 @@ dsListComp :: [TypecheckedStmt] ...@@ -51,17 +51,19 @@ dsListComp :: [TypecheckedStmt]
-> DsM CoreExpr -> DsM CoreExpr
dsListComp quals elt_ty dsListComp quals elt_ty
| opt_RulesOff || opt_IgnoreIfacePragmas -- Either rules are switched off, or = getDOptsDs `thenDs` \dflags ->
-- we are ignoring what there are; if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
-- Either way foldr/build won't happen, so -- Either rules are switched off, or we are ignoring what there are;
-- use the more efficient Wadler-style desugaring -- Either way foldr/build won't happen, so use the more efficient
|| isParallelComp quals -- Foldr-style desugaring can't handle -- Wadler-style desugaring
-- parallel list comprehensions || isParallelComp quals
= deListComp quals (mkNilExpr elt_ty) -- Foldr-style desugaring can't handle
-- parallel list comprehensions
| otherwise -- Foldr/build should be enabled, so desugar then deListComp quals (mkNilExpr elt_ty)
-- into foldrs and builds
= newTyVarsDs [alphaTyVar] `thenDs` \ [n_tyvar] -> else -- Foldr/build should be enabled, so desugar
-- into foldrs and builds
newTyVarsDs [alphaTyVar] `thenDs` \ [n_tyvar] ->
let let
n_ty = mkTyVarTy n_tyvar n_ty = mkTyVarTy n_tyvar
c_ty = mkFunTys [elt_ty, n_ty] n_ty c_ty = mkFunTys [elt_ty, n_ty] n_ty
......
...@@ -113,7 +113,7 @@ dsReify (ReifyOut ReifyType name) ...@@ -113,7 +113,7 @@ dsReify (ReifyOut ReifyType name)
dsReify r@(ReifyOut ReifyDecl name) dsReify r@(ReifyOut ReifyDecl name)
= do { thing <- dsLookupGlobal name ; = do { thing <- dsLookupGlobal name ;
mb_d <- repTyClD (ifaceTyThing thing) ; mb_d <- repTyClD (ifaceTyThing True{-omit pragmas-} thing) ;
case mb_d of case mb_d of
Just (MkC d) -> return d Just (MkC d) -> return d
Nothing -> pprPanic "dsReify" (ppr r) Nothing -> pprPanic "dsReify" (ppr r)
......
{-# OPTIONS -#include "Linker.h" #-} {-# 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 -- GHC Interactive User Interface
-- --
...@@ -492,7 +492,7 @@ info s = do ...@@ -492,7 +492,7 @@ info s = do
showThing (ty_thing, fixity) showThing (ty_thing, fixity)
= vcat [ text "-- " <> showTyThing ty_thing, = vcat [ text "-- " <> showTyThing ty_thing,
showFixity fixity (getName ty_thing), showFixity fixity (getName ty_thing),
ppr (ifaceTyThing ty_thing) ] ppr (ifaceTyThing True{-omit prags-} ty_thing) ]
showFixity fix name showFixity fix name
| fix == defaultFixity = empty | fix == defaultFixity = empty
...@@ -723,10 +723,10 @@ browseModule m exports_only = do ...@@ -723,10 +723,10 @@ browseModule m exports_only = do
thing_names = map getName things thing_names = map getName things
thingDecl thing@(AnId id) = ifaceTyThing thing thingDecl thing@(AnId id) = ifaceTyThing True{-omit prags-} thing
thingDecl thing@(AClass c) = thingDecl thing@(AClass c) =
let rn_decl = ifaceTyThing thing in let rn_decl = ifaceTyThing True{-omit prags-} thing in
case rn_decl of case rn_decl of
ClassDecl { tcdSigs = cons } -> ClassDecl { tcdSigs = cons } ->
rn_decl{ tcdSigs = filter methodIsVisible cons } rn_decl{ tcdSigs = filter methodIsVisible cons }
...@@ -735,7 +735,7 @@ browseModule m exports_only = do ...@@ -735,7 +735,7 @@ browseModule m exports_only = do
methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names
thingDecl thing@(ATyCon t) = thingDecl thing@(ATyCon t) =
let rn_decl = ifaceTyThing thing in let rn_decl = ifaceTyThing True{-omit prags-} thing in
case rn_decl of case rn_decl of
TyData { tcdCons = DataCons cons } -> TyData { tcdCons = DataCons cons } ->
rn_decl{ tcdCons = DataCons (filter conIsVisible cons) } rn_decl{ tcdCons = DataCons (filter conIsVisible cons) }
...@@ -747,8 +747,6 @@ browseModule m exports_only = do ...@@ -747,8 +747,6 @@ browseModule m exports_only = do
vcat (map (ppr . thingDecl) things'))) vcat (map (ppr . thingDecl) things')))
) )
where
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- Setting the module context -- Setting the module context
...@@ -963,7 +961,7 @@ showBindings = do ...@@ -963,7 +961,7 @@ showBindings = do
cms <- getCmState cms <- getCmState
let let
unqual = cmGetPrintUnqual cms 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)) io (mapM_ showBinding (cmGetBindings cms))
return () return ()
......
...@@ -28,7 +28,7 @@ import Module ( moduleName ) ...@@ -28,7 +28,7 @@ import Module ( moduleName )
import OccName ( OccName ) import OccName ( OccName )
import RnHsSyn import RnHsSyn
import DriverState ( v_Build_tag ) import DriverState ( v_Build_tag )
import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_HiVersion ) import CmdLineOpts ( opt_HiVersion )
import Panic import Panic
import SrcLoc import SrcLoc
import Binary import Binary
...@@ -170,9 +170,7 @@ instance (Binary name) => Binary (TyClDecl name) where ...@@ -170,9 +170,7 @@ instance (Binary name) => Binary (TyClDecl name) where
name <- get bh name <- get bh
ty <- lazyGet bh ty <- lazyGet bh
idinfo <- lazyGet bh idinfo <- lazyGet bh
let idinfo' | opt_IgnoreIfacePragmas = [] return (IfaceSig name ty idinfo noSrcLoc)
| otherwise = idinfo
return (IfaceSig name ty idinfo' noSrcLoc)
1 -> error "Binary.get(TyClDecl): ForeignType" 1 -> error "Binary.get(TyClDecl): ForeignType"
2 -> do 2 -> do
n_or_d <- get bh n_or_d <- get bh
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
\begin{code} \begin{code}
module CmdLineOpts ( module CmdLineOpts (
CoreToDo(..), StgToDo(..), CoreToDo(..), buildCoreToDo, StgToDo(..),
SimplifierSwitch(..), SimplifierSwitch(..),
SimplifierMode(..), FloatOutSwitches(..), SimplifierMode(..), FloatOutSwitches(..),
...@@ -30,6 +30,7 @@ module CmdLineOpts ( ...@@ -30,6 +30,7 @@ module CmdLineOpts (
getOpts, -- (DynFlags -> [a]) -> IO [a] getOpts, -- (DynFlags -> [a]) -> IO [a]
setLang, setLang,
getVerbFlag, getVerbFlag,
setOptLevel,
-- Manipulating the DynFlags state -- Manipulating the DynFlags state
getDynFlags, -- IO DynFlags getDynFlags, -- IO DynFlags
...@@ -74,14 +75,9 @@ module CmdLineOpts ( ...@@ -74,14 +75,9 @@ module CmdLineOpts (
opt_NoMethodSharing, opt_NoMethodSharing,
opt_DoSemiTagging, opt_DoSemiTagging,
opt_LiberateCaseThreshold, opt_LiberateCaseThreshold,
opt_StgDoLetNoEscapes,
opt_CprOff, opt_CprOff,
opt_RulesOff, opt_RulesOff,
opt_UnboxStrictFields,
opt_SimplNoPreInlining, opt_SimplNoPreInlining,
opt_SimplDoEtaReduction,
opt_SimplDoLambdaEtaExpansion,
opt_SimplCaseMerge,
opt_SimplExcessPrecision, opt_SimplExcessPrecision,
opt_MaxWorkerArgs, opt_MaxWorkerArgs,
...@@ -101,11 +97,8 @@ module CmdLineOpts ( ...@@ -101,11 +97,8 @@ module CmdLineOpts (
opt_GranMacros, opt_GranMacros,
opt_HiVersion, opt_HiVersion,
opt_HistorySize, opt_HistorySize,
opt_IgnoreAsserts,
opt_IgnoreIfacePragmas,
opt_NoHiCheck, opt_NoHiCheck,
opt_OmitBlackHoling, opt_OmitBlackHoling,
opt_OmitInterfacePragmas,
opt_NoPruneDecls, opt_NoPruneDecls,
opt_Static, opt_Static,
opt_Unregisterised, opt_Unregisterised,
...@@ -297,10 +290,21 @@ data DynFlag ...@@ -297,10 +290,21 @@ data DynFlag
| Opt_Generics | Opt_Generics
| Opt_NoImplicitPrelude | Opt_NoImplicitPrelude
-- optimisation opts
| Opt_Strictness
| Opt_CSE
| Opt_IgnoreInterfacePragmas
| Opt_OmitInterfacePragmas
| Opt_DoLambdaEtaExpansion
| Opt_IgnoreAsserts
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
deriving (Eq) deriving (Eq)
data DynFlags = DynFlags { data DynFlags = DynFlags {
coreToDo :: [CoreToDo], coreToDo :: Maybe [CoreToDo], -- reserved for use with -Ofile
stgToDo :: [StgToDo], stgToDo :: [StgToDo],
hscLang :: HscLang, hscLang :: HscLang,
hscOutName :: String, -- name of the output file hscOutName :: String, -- name of the output file
...@@ -308,6 +312,9 @@ data DynFlags = DynFlags { ...@@ -308,6 +312,9 @@ data DynFlags = DynFlags {
hscStubCOutName :: String, -- name of the .stub_c output file hscStubCOutName :: String, -- name of the .stub_c output file
extCoreName :: String, -- name of the .core output file extCoreName :: String, -- name of the .core output file
verbosity :: Int, -- verbosity level verbosity :: Int, -- verbosity level
optLevel :: Int, -- optimisation level
maxSimplIterations :: Int, -- max simplifier iterations
ruleCheck :: Maybe String,
cppFlag :: Bool, -- preprocess with cpp? cppFlag :: Bool, -- preprocess with cpp?
ppFlag :: Bool, -- preprocess with a Haskell Pp? ppFlag :: Bool, -- preprocess with a Haskell Pp?
stolen_x86_regs :: Int, stolen_x86_regs :: Int,
...@@ -346,12 +353,15 @@ defaultHscLang ...@@ -346,12 +353,15 @@ defaultHscLang
| otherwise = HscC | otherwise = HscC
defaultDynFlags = DynFlags { defaultDynFlags = DynFlags {
coreToDo = [], stgToDo = [], coreToDo = Nothing, stgToDo = [],
hscLang = defaultHscLang, hscLang = defaultHscLang,
hscOutName = "", hscOutName = "",
hscStubHOutName = "", hscStubCOutName = "", hscStubHOutName = "", hscStubCOutName = "",
extCoreName = "", extCoreName = "",
verbosity = 0, verbosity = 0,
optLevel = 0,
maxSimplIterations = 4,
ruleCheck = Nothing,
cppFlag = False, cppFlag = False,
ppFlag = False, ppFlag = False,
stolen_x86_regs = 4, stolen_x86_regs = 4,
...@@ -366,9 +376,21 @@ defaultDynFlags = DynFlags { ...@@ -366,9 +376,21 @@ defaultDynFlags = DynFlags {
opt_I = [], opt_I = [],
opt_i = [], opt_i = [],
#endif #endif
flags = [Opt_Generics] ++ standardWarnings, flags = [
-- Generating the helper-functions for Opt_Generics,
-- generics is now on by default -- 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 { ...@@ -385,7 +407,7 @@ defaultDynFlags = DynFlags {
dopt :: DynFlag -> DynFlags -> Bool dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags) dopt f dflags = f `elem` (flags dflags)
dopt_CoreToDo :: DynFlags -> [CoreToDo] dopt_CoreToDo :: DynFlags -> Maybe [CoreToDo]
dopt_CoreToDo = coreToDo dopt_CoreToDo = coreToDo
dopt_StgToDo :: DynFlags -> [StgToDo] dopt_StgToDo :: DynFlags -> [StgToDo]
...@@ -418,9 +440,173 @@ setLang l = updDynFlags (\ dfs -> case hscLang dfs of ...@@ -418,9 +440,173 @@ setLang l = updDynFlags (\ dfs -> case hscLang dfs of
getVerbFlag = do getVerbFlag = do
verb <- dynFlag verbosity verb <- dynFlag verbosity
if verb >= 3 then return "-v" else return "" 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 -- Mess about with the mutable variables holding the dynamic arguments
-- v_InitDynFlags -- v_InitDynFlags
...@@ -433,7 +619,6 @@ getVerbFlag = do ...@@ -433,7 +619,6 @@ getVerbFlag = do
-- to the value of v_InitDynFlags before each compilation, then -- to the value of v_InitDynFlags before each compilation, then
-- updated by reading any OPTIONS pragma in the current module. -- updated by reading any OPTIONS pragma in the current module.
\begin{code}
GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags) GLOBAL_VAR(v_InitDynFlags, defaultDynFlags, DynFlags)
GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags) GLOBAL_VAR(v_DynFlags, defaultDynFlags, DynFlags)
...@@ -590,8 +775,6 @@ opt_CprOff = lookUp FSLIT("-fcpr-off") ...@@ -590,8 +775,6 @@ opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off") opt_RulesOff = lookUp FSLIT("-frules-off")
-- Switch off CPR analysis in the new demand analyser -- Switch off CPR analysis in the new demand analyser
opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int) 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) opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
{- {-
...@@ -608,20 +791,14 @@ opt_EnsureSplittableC = lookUp FSLIT("-fglobalise-toplev-names") ...@@ -608,20 +791,14 @@ opt_EnsureSplittableC = lookUp FSLIT("-fglobalise-toplev-names")
opt_GranMacros = lookUp FSLIT("-fgransim") opt_GranMacros = lookUp FSLIT("-fgransim")
opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int opt_HiVersion = read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
opt_HistorySize = lookup_def_int "-fhistory-size" 20 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_NoHiCheck = lookUp FSLIT("-fno-hi-version-check")
opt_OmitBlackHoling = lookUp FSLIT("-dno-black-holing") opt_OmitBlackHoling = lookUp FSLIT("-dno-black-holing")
opt_OmitInterfacePragmas = lookUp FSLIT("-fomit-interface-pragmas")
opt_RuntimeTypes = lookUp FSLIT("-fruntime-types") opt_RuntimeTypes = lookUp FSLIT("-fruntime-types")
-- Simplifier switches -- Simplifier switches
opt_SimplNoPreInlining = lookUp FSLIT("-fno-pre-inlining") opt_SimplNoPreInlining = lookUp FSLIT("-fno-pre-inlining")
-- NoPreInlining is there just to see how bad things -- NoPreInlining is there just to see how bad things
-- get if you don't do it! -- get if you don't do it!