X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FStaticFlags.hs;h=126b3a064ae0b9d814ccd6d668dced502dc2d2ba;hb=46bef1c09f499c5b34a00b650614bebfa1d6ba4b;hp=026273e7e13936af7c5befcc8b6f002d7739f3c7;hpb=ccd0e382566940a508fcb1aa7487bc7a785fc329;p=ghc-hetmet.git diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 026273e..126b3a0 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -26,11 +26,7 @@ module StaticFlags ( opt_NoDebugOutput, -- profiling opts - opt_AutoSccsOnAllToplevs, - opt_AutoSccsOnExportedToplevs, - opt_AutoSccsOnIndividualCafs, opt_SccProfilingOn, - opt_DoTickyProfiling, -- Hpc opts opt_Hpc, @@ -41,7 +37,6 @@ module StaticFlags ( opt_Parallel, -- optimisation opts - opt_PassCaseBndrToJoinPoints, opt_DsMultiTyVar, opt_NoStateHack, opt_SimpleListLiterals, @@ -73,7 +68,6 @@ module StaticFlags ( opt_HistorySize, opt_OmitBlackHoling, opt_Unregisterised, - opt_EmitExternalCore, v_Ld_inputs, tablesNextToCode, opt_StubDeadValues, @@ -140,7 +134,7 @@ lookUp sw = sw `elem` packed_static_opts -- (lookup_str "foo") looks for the flag -foo=X or -fooX, -- and returns the string X lookup_str sw - = case firstJust (map (maybePrefixMatch sw) staticFlags) of + = case firstJust (map (stripPrefix sw) staticFlags) of Just ('=' : str) -> Just str Just str -> Just str Nothing -> Nothing @@ -198,16 +192,8 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") -- profiling opts -opt_AutoSccsOnAllToplevs :: Bool -opt_AutoSccsOnAllToplevs = lookUp (fsLit "-fauto-sccs-on-all-toplevs") -opt_AutoSccsOnExportedToplevs :: Bool -opt_AutoSccsOnExportedToplevs = lookUp (fsLit "-fauto-sccs-on-exported-toplevs") -opt_AutoSccsOnIndividualCafs :: Bool -opt_AutoSccsOnIndividualCafs = lookUp (fsLit "-fauto-sccs-on-individual-cafs") opt_SccProfilingOn :: Bool opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling") -opt_DoTickyProfiling :: Bool -opt_DoTickyProfiling = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways) -- Hpc opts opt_Hpc :: Bool @@ -226,9 +212,6 @@ opt_DsMultiTyVar :: Bool opt_DsMultiTyVar = not (lookUp (fsLit "-fno-ds-multi-tyvar")) -- On by default -opt_PassCaseBndrToJoinPoints :: Bool -opt_PassCaseBndrToJoinPoints = lookUp (fsLit "-fpass-case-bndr-to-join-points") - opt_SpecInlineJoinPoints :: Bool opt_SpecInlineJoinPoints = lookUp (fsLit "-fspec-inline-join-points") @@ -267,7 +250,7 @@ opt_SimplExcessPrecision = lookUp (fsLit "-fexcess-precision") opt_UF_CreationThreshold :: Int opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int) opt_UF_UseThreshold :: Int -opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (8::Int) -- Discounts can be big +opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (6::Int) -- Discounts can be big opt_UF_FunAppDiscount :: Int opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) -- It's great to inline a fn opt_UF_KeenessFactor :: Float @@ -297,9 +280,6 @@ tablesNextToCode :: Bool tablesNextToCode = not opt_Unregisterised && cGhcEnableTablesNextToCode == "YES" -opt_EmitExternalCore :: Bool -opt_EmitExternalCore = lookUp (fsLit "-fext-core") - -- Include full span info in error messages, instead of just the start position. opt_ErrorSpans :: Bool opt_ErrorSpans = lookUp (fsLit "-ferror-spans") @@ -336,6 +316,7 @@ data WayName = WayThreaded | WayDebug | WayProf + | WayEventLog | WayTicky | WayPar | WayGran @@ -375,6 +356,7 @@ allowed_combination way = and [ x `allowedWith` y WayProf `allowedWith` WayNDP = True WayThreaded `allowedWith` WayProf = True + WayThreaded `allowedWith` WayEventLog = True _ `allowedWith` _ = False @@ -441,6 +423,10 @@ way_details = , "-DPROFILING" , "-optc-DPROFILING" ]), + (WayEventLog, Way "l" True "RTS Event Logging" + [ "-DEVENTLOG" + , "-optc-DEVENTLOG" ]), + (WayTicky, Way "t" True "Ticky-ticky Profiling" [ "-DTICKY_TICKY" , "-optc-DTICKY_TICKY" ]),