X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=ab9d8216a2a6e10a7f8d39f9221e44b5eadbea32;hb=f3795c06370ed317957028027e4d18682bfeb447;hp=f7a5d4af95ce0c7c8432431165ace77647755800;hpb=f04dead93a15af1cb818172f207b8a81d2c81298;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index f7a5d4a..ab9d821 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -351,6 +351,7 @@ data DynFlags = DynFlags { maxSimplIterations :: Int, -- ^ Max simplifier iterations shouldDumpSimplPhase :: SimplifierMode -> Bool, ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function @@ -545,7 +546,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 @@ -606,6 +609,8 @@ defaultDynFlags = specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, + strictnessBefore = [], + #ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, #endif @@ -1066,9 +1071,13 @@ getCoreToDo dflags maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) + maybe_strictness_before phase + = runWhen (phase `elem` strictnessBefore dflags) CoreDoStrictness + simpl_phase phase names iter = CoreDoPasses - [ CoreDoSimplify (SimplPhase phase names) [ + [ maybe_strictness_before phase, + CoreDoSimplify (SimplPhase phase names) [ MaxSimplifierIterations iter ], maybe_rule_check phase @@ -1559,6 +1568,10 @@ dynamic_flags = [ (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) Supported + , Flag "fstrictness-before" + (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs }))) + Supported + ------ Profiling ---------------------------------------------------- -- XXX Should the -f* flags be deprecated? @@ -1800,7 +1813,8 @@ xFlags = [ ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), ( "Rank2Types", Opt_Rank2Types, const Supported ), ( "RankNTypes", Opt_RankNTypes, const Supported ), - ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, + const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ), ( "TypeOperators", Opt_TypeOperators, const Supported ), ( "RecursiveDo", Opt_RecursiveDo, deprecatedForLanguage "DoRec"),