X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=be0212e744d2685b29e88b4f51ea18cd7d82b8c9;hp=ed5f359b9c8fe87860443e84f525f259603eac2c;hb=842e9d6628a27cf1f420d53f6a5901935dc50c54;hpb=4dd7f35b7055e3ff9ff5fed9e90e1c8cbe5e6a9b diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index ed5f359..be0212e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -60,8 +60,6 @@ module DynFlags ( compilerInfo, ) where --- XXX This define is a bit of a hack, and should be done more nicely -#define FAST_STRING_NOT_NEEDED 1 #include "HsVersions.h" import Module @@ -239,6 +237,7 @@ data DynFlag -- optimisation opts | Opt_Strictness | Opt_FullLaziness + | Opt_StaticArgumentTransformation | Opt_CSE | Opt_LiberateCase | Opt_SpecConstr @@ -249,6 +248,7 @@ data DynFlag | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields + | Opt_MethodSharing | Opt_DictsCheap | Opt_RewriteRules | Opt_Vectorise @@ -305,6 +305,7 @@ data DynFlags = DynFlags { ruleCheck :: Maybe String, specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr + specConstrCount :: Maybe Int, -- Max number of specialisations for any one function liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase stolen_x86_regs :: Int, @@ -496,6 +497,7 @@ defaultDynFlags = shouldDumpSimplPhase = const False, ruleCheck = Nothing, specConstrThreshold = Just 200, + specConstrCount = Just 3, liberateCaseThreshold = Just 200, stolen_x86_regs = 4, cmdlineHcIncludes = [], @@ -554,6 +556,8 @@ defaultDynFlags = Opt_ImplicitPrelude, Opt_MonomorphismRestriction, + Opt_MethodSharing, + Opt_DoAsmMangling, Opt_GenManifest, @@ -708,6 +712,7 @@ optLevelFlags , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) + , ([2], Opt_StaticArgumentTransformation) , ([0,1,2], Opt_DoLambdaEtaExpansion) -- This one is important for a tiresome reason: @@ -827,6 +832,7 @@ getCoreToDo dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags vectorisation = dopt Opt_Vectorise dflags + static_args = dopt Opt_StaticArgumentTransformation dflags maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) @@ -870,11 +876,18 @@ getCoreToDo dflags MaxSimplifierIterations max_iter ] - core_todo = + core_todo = if opt_level == 0 then - [simpl_phase 0 ["final"] max_iter] + [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]), + simpl_phase 0 ["final"] max_iter] else {- opt_level >= 1 -} [ + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else + runWhen static_args CoreDoStaticArgs, + -- initial simplify: mk specialiser happy: minimum effort please simpl_gently, @@ -1147,7 +1160,8 @@ dynamic_flags = [ , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles) , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning) , ( "ddump-to-file", setDumpFlag Opt_DumpToFile) - , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs)) + , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs) + , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) @@ -1173,6 +1187,7 @@ dynamic_flags = [ ------ Optimisation flags ------------------------------------------ , ( "O" , NoArg (upd (setOptLevel 1))) , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated + , ( "Odph" , NoArg (upd setDPHOpt)) , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) -- If the number is missing, use 1 @@ -1185,6 +1200,10 @@ dynamic_flags = [ upd (\dfs -> dfs{ specConstrThreshold = Just n }))) , ( "fno-spec-constr-threshold", NoArg ( upd (\dfs -> dfs{ specConstrThreshold = Nothing }))) + , ( "fspec-constr-count", IntSuffix (\n -> + upd (\dfs -> dfs{ specConstrCount = Just n }))) + , ( "fno-spec-constr-count", NoArg ( + upd (\dfs -> dfs{ specConstrCount = Nothing }))) , ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n }))) , ( "fno-liberate-case-threshold", NoArg ( @@ -1245,6 +1264,7 @@ fFlags = [ ( "warn-tabs", Opt_WarnTabs ), ( "print-explicit-foralls", Opt_PrintExplicitForalls ), ( "strictness", Opt_Strictness ), + ( "static-argument-transformation", Opt_StaticArgumentTransformation ), ( "full-laziness", Opt_FullLaziness ), ( "liberate-case", Opt_LiberateCase ), ( "spec-constr", Opt_SpecConstr ), @@ -1256,6 +1276,7 @@ fFlags = [ ( "do-eta-reduction", Opt_DoEtaReduction ), ( "case-merge", Opt_CaseMerge ), ( "unbox-strict-fields", Opt_UnboxStrictFields ), + ( "method-sharing", Opt_MethodSharing ), ( "dicts-cheap", Opt_DictsCheap ), ( "excess-precision", Opt_ExcessPrecision ), ( "asm-mangling", Opt_DoAsmMangling ), @@ -1465,9 +1486,16 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag - = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) + | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) + | otherwise = NoArg (setDynFlag dump_flag) + where -- Whenver we -ddump, switch off the recompilation checker, -- else you don't see the dump! + -- However, certain dumpy-things are really interested in what's going + -- on during recompilation checking, so in those cases we + -- don't want to turn it off. + force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, + Opt_D_dump_hi_diffs] setVerboseCore2Core :: DynP () setVerboseCore2Core = do setDynFlag Opt_ForceRecomp @@ -1478,26 +1506,31 @@ setDumpSimplPhases :: String -> DynP () setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp upd (\s -> s { shouldDumpSimplPhase = spec }) where + spec :: SimplifierMode -> Bool spec = join (||) - . map (join (&&)) - . map (map match) - . map (split ':') + . map (join (&&) . map match . split ':') . split ',' $ case s of '=' : s' -> s' _ -> s + join :: (Bool -> Bool -> Bool) + -> [SimplifierMode -> Bool] + -> SimplifierMode -> Bool join _ [] = const True join op ss = foldr1 (\f g x -> f x `op` g x) ss + match :: String -> SimplifierMode -> Bool match "" = const True match s = case reads s of [(n,"")] -> phase_num n _ -> phase_name s + phase_num :: Int -> SimplifierMode -> Bool phase_num n (SimplPhase k _) = n == k phase_num _ _ = False + phase_name :: String -> SimplifierMode -> Bool phase_name s SimplGently = s == "gentle" phase_name s (SimplPhase _ ss) = s `elem` ss @@ -1557,6 +1590,24 @@ setOptLevel n dflags = updOptLevel n dflags +-- -Odph is equivalent to +-- +-- -O2 optimise as much as possible +-- -fno-method-sharing sharing specialisation defeats fusion +-- sometimes +-- -fdicts-cheap always inline dictionaries +-- -fmax-simplifier-iterations20 this is necessary sometimes +-- -fno-spec-constr-threshold run SpecConstr even for big loops +-- +setDPHOpt :: DynFlags -> DynFlags +setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 + , specConstrThreshold = Nothing + }) + `dopt_set` Opt_DictsCheap + `dopt_unset` Opt_MethodSharing + + + setMainIs :: String -> DynP () setMainIs arg | not (null main_fn) && isLower (head main_fn)