X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=a008ea681fd83e76c96c2270a07e9ab1f717f63b;hb=b84ba676034763b3082bbd9405794a4fde499d14;hp=cd0f21294e4c7746b8fcf1d28a99071500dbfb13;hpb=560bf7c0d6a718ab7c14f286469f68a6244b5a1a;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index cd0f212..a008ea6 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -82,6 +82,7 @@ import Maybes ( orElse ) import SrcLoc import FastString import FiniteMap +import BasicTypes ( CompilerPhase ) import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -258,6 +259,7 @@ data DynFlag | Opt_PackageImports | Opt_NewQualifiedOperators | Opt_ExplicitForAll + | Opt_AlternativeLayoutRule | Opt_PrintExplicitForalls @@ -270,8 +272,6 @@ data DynFlag | Opt_CSE | Opt_LiberateCase | Opt_SpecConstr - | Opt_IgnoreInterfacePragmas - | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction @@ -279,12 +279,16 @@ data DynFlag | Opt_UnboxStrictFields | Opt_MethodSharing | Opt_DictsCheap - | Opt_InlineIfEnoughArgs | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_Vectorise | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + -- Interface files + | Opt_IgnoreInterfacePragmas + | Opt_OmitInterfacePragmas + | Opt_ExposeAllUnfoldings + -- profiling opts | Opt_AutoSccsOnAllToplevs | Opt_AutoSccsOnExportedToplevs @@ -345,7 +349,7 @@ data DynFlags = DynFlags { hscTarget :: HscTarget, hscOutName :: String, -- ^ Name of the output file extCoreName :: String, -- ^ Name of the .hcr output file - verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels" + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level simplPhases :: Int, -- ^ Number of simplifier phases maxSimplIterations :: Int, -- ^ Max simplifier iterations @@ -381,6 +385,7 @@ data DynFlags = DynFlags { -- paths etc. objectDir :: Maybe String, + dylibInstallName :: Maybe String, hiDir :: Maybe String, stubDir :: Maybe String, @@ -546,7 +551,9 @@ isNoLink _ = False -- Is it worth evaluating this Bool and caching it in the DynFlags value -- during initDynFlags? doingTickyProfiling :: DynFlags -> Bool -doingTickyProfiling dflags = WayTicky `elem` wayNames dflags +doingTickyProfiling _ = opt_Ticky + -- XXX -ticky is a static flag, because it implies -debug which is also + -- static. If the way flags were made dynamic, we could fix this. data PackageFlag = ExposePackage String @@ -624,6 +631,7 @@ defaultDynFlags = thisPackage = mainPackageId, objectDir = Nothing, + dylibInstallName = Nothing, hiDir = Nothing, stubDir = Nothing, @@ -729,9 +737,8 @@ defaultDynFlags = } {- - #verbosity_levels# - Verbosity levels: - +Note [Verbosity levels] +~~~~~~~~~~~~~~~~~~~~~~~ 0 | print errors & warnings only 1 | minimal verbosity: print "compiling M ... done." for each module. 2 | equivalent to -dshow-passes @@ -766,7 +773,7 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir, setHiDir, setStubDir, setOutputDir, +setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres, addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, @@ -781,6 +788,7 @@ setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file -- \#included from the .hc file when compiling with -fvia-C. setOutputDir f = setObjectDir f . setHiDir f . setStubDir f +setDylibInstallName f d = d{ dylibInstallName = Just f} setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -994,8 +1002,8 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoOldStrictness | CoreDoGlomBinds | CoreCSE - | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules - -- matching this string + | CoreDoRuleCheck CompilerPhase String -- Check for non-application of rules + -- matching this string | CoreDoVectorisation PackageId | CoreDoNothing -- Useful when building up | CoreDoPasses [CoreToDo] -- lists of these things @@ -1003,18 +1011,27 @@ data CoreToDo -- These are diff core-to-core passes, data SimplifierMode -- See comments in SimplMonad = SimplGently - | SimplPhase Int [String] + { sm_rules :: Bool -- Whether RULES are enabled + , sm_inline :: Bool } -- Whether inlining is enabled -instance Outputable SimplifierMode where - ppr SimplGently = ptext (sLit "gentle") - ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss)) + | SimplPhase + { sm_num :: Int -- Phase number; counts downward so 0 is last phase + , sm_names :: [String] } -- Name(s) of the phase +instance Outputable SimplifierMode where + ppr (SimplPhase { sm_num = n, sm_names = ss }) + = int n <+> brackets (text (concat $ intersperse "," ss)) + ppr (SimplGently { sm_rules = r, sm_inline = i }) + = ptext (sLit "gentle") <> + brackets (pp_flag r (sLit "rules") <> comma <> + pp_flag i (sLit "inline")) + where + pp_flag f s = ppUnless f (ptext (sLit "no")) <+> ptext s data SimplifierSwitch = MaxSimplifierIterations Int | NoCaseOfCase - data FloatOutSwitches = FloatOutSwitches { floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level floatOutConstants :: Bool -- ^ True <=> float constants to top level, @@ -1102,7 +1119,9 @@ getCoreToDo dflags -- initial simplify: mk specialiser happy: minimum effort please - simpl_gently = CoreDoSimplify SimplGently [ + simpl_gently = CoreDoSimplify + (SimplGently { sm_rules = True, sm_inline = False }) + [ -- Simplify "gently" -- Don't inline anything till full laziness has bitten -- In particular, inlining wrappers inhibits floating @@ -1166,10 +1185,6 @@ getCoreToDo dflags -- Don't stop now! simpl_phase 0 ["main"] (max max_iter 3), - -#ifdef OLD_STRICTNESS - CoreDoOldStrictness, -#endif runWhen strictness (CoreDoPasses [ CoreDoStrictness, CoreDoWorkerWrapper, @@ -1312,6 +1327,7 @@ dynamic_flags = [ Supported , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode)) Supported + , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported ------- Libraries --------------------------------------------------- , Flag "L" (Prefix addLibraryPath ) Supported @@ -1463,7 +1479,8 @@ dynamic_flags = [ Supported , Flag "dsource-stats" (setDumpFlag Opt_D_source_stats) Supported - , Flag "dverbose-core2core" (NoArg setVerboseCore2Core) + , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2) + ; setVerboseCore2Core })) Supported , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg) Supported @@ -1716,6 +1733,7 @@ fFlags = [ ( "cse", Opt_CSE, const Supported ), ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ), ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ), + ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, const Supported ), ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ), ( "ignore-asserts", Opt_IgnoreAsserts, const Supported ), ( "do-eta-reduction", Opt_DoEtaReduction, const Supported ), @@ -1723,7 +1741,6 @@ fFlags = [ ( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ), ( "method-sharing", Opt_MethodSharing, const Supported ), ( "dicts-cheap", Opt_DictsCheap, const Supported ), - ( "inline-if-enough-args", Opt_InlineIfEnoughArgs, const Supported ), ( "excess-precision", Opt_ExcessPrecision, const Supported ), ( "eager-blackholing", Opt_EagerBlackHoling, const Supported ), ( "asm-mangling", Opt_DoAsmMangling, const Supported ), @@ -1841,6 +1858,7 @@ xFlags = [ -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ), + ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ), ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), @@ -2018,7 +2036,8 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag - = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile) + = NoArg (do { setDynFlag dump_flag + ; when want_recomp forceRecompile }) where -- Certain dumpy-things are really interested in what's going -- on during recompilation checking, so in those cases we @@ -2070,8 +2089,8 @@ setDumpSimplPhases s = do forceRecompile phase_num _ _ = False phase_name :: String -> SimplifierMode -> Bool - phase_name s SimplGently = s == "gentle" - phase_name s (SimplPhase _ ss) = s `elem` ss + phase_name s (SimplGently {}) = s == "gentle" + phase_name s (SimplPhase { sm_names = ss }) = s `elem` ss setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) @@ -2146,7 +2165,6 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 }) `dopt_set` Opt_DictsCheap `dopt_unset` Opt_MethodSharing - `dopt_set` Opt_InlineIfEnoughArgs data DPHBackend = DPHPar | DPHSeq