diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2017-02-02 14:37:24 -0500 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-02-02 22:13:53 -0500 |
commit | bbd3c399939311ec3e308721ab87ca6b9443f358 (patch) | |
tree | 1a398f3857502ab42f350008f83b7c67f0d9ff1e /compiler/specialise | |
parent | 6128b2ffbe36ed2779583e05ee9d817eaafc1c9c (diff) | |
download | haskell-bbd3c399939311ec3e308721ab87ca6b9443f358.tar.gz |
Ditch static flags
This patch converts the 4 lasting static flags (read from the command
line and unsafely stored in immutable global variables) into dynamic
flags. Most use cases have been converted into reading them from a DynFlags.
In cases for which we don't have easy access to a DynFlags, we read from
'unsafeGlobalDynFlags' that is set at the beginning of each 'runGhc'.
It's not perfect (not thread-safe) but it is still better as we can
set/unset these 4 flags before each run when using GHC API.
Updates haddock submodule.
Rebased and finished by: bgamari
Test Plan: validate
Reviewers: goldfire, erikd, hvr, austin, simonmar, bgamari
Reviewed By: simonmar
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2839
GHC Trac Issues: #8440
Diffstat (limited to 'compiler/specialise')
-rw-r--r-- | compiler/specialise/Rules.hs | 24 | ||||
-rw-r--r-- | compiler/specialise/SpecConstr.hs | 15 |
2 files changed, 21 insertions, 18 deletions
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index ba44794db4..168104156f 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -54,7 +54,6 @@ import NameEnv import UniqFM import Unify ( ruleMatchTyKiX ) import BasicTypes ( Activation, CompilerPhase, isActive, pprRuleName ) -import StaticFlags ( opt_PprStyle_Debug ) import DynFlags ( DynFlags ) import Outputable import FastString @@ -255,14 +254,14 @@ functions (lambdas) except by name, so in this case it seems like a good idea to treat 'M.k' as a roughTopName of the call. -} -pprRulesForUser :: [CoreRule] -> SDoc +pprRulesForUser :: DynFlags -> [CoreRule] -> SDoc -- (a) tidy the rules -- (b) sort them into order based on the rule name -- (c) suppress uniques (unless -dppr-debug is on) -- This combination makes the output stable so we can use in testing -- It's here rather than in PprCore because it calls tidyRules -pprRulesForUser rules - = withPprStyle defaultUserStyle $ +pprRulesForUser dflags rules + = withPprStyle (defaultUserStyle dflags) $ pprRules $ sortBy (comparing ru_name) $ tidyRules emptyTidyEnv rules @@ -419,15 +418,16 @@ findBest _ (rule,ans) [] = (rule,ans) findBest target (rule1,ans1) ((rule2,ans2):prs) | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs - | debugIsOn = let pp_rule rule - | opt_PprStyle_Debug = ppr rule - | otherwise = doubleQuotes (ftext (ru_name rule)) + | debugIsOn = let pp_rule rule = sdocWithPprDebug $ \dbg -> if dbg + then ppr rule + else doubleQuotes (ftext (ru_name rule)) in pprTrace "Rules.findBest: rule overlap (Rule 1 wins)" - (vcat [if opt_PprStyle_Debug then - text "Expression to match:" <+> ppr fn <+> sep (map ppr args) - else empty, - text "Rule 1:" <+> pp_rule rule1, - text "Rule 2:" <+> pp_rule rule2]) $ + (vcat [ sdocWithPprDebug $ \dbg -> if dbg + then text "Expression to match:" <+> ppr fn + <+> sep (map ppr args) + else empty + , text "Rule 1:" <+> pp_rule rule1 + , text "Rule 2:" <+> pp_rule rule2]) $ findBest target (rule1,ans1) prs | otherwise = findBest target (rule1,ans1) prs where diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs index 5ee2dec594..f6e10adad4 100644 --- a/compiler/specialise/SpecConstr.hs +++ b/compiler/specialise/SpecConstr.hs @@ -41,8 +41,7 @@ import VarEnv import VarSet import Name import BasicTypes -import DynFlags ( DynFlags(..) ) -import StaticFlags ( opt_PprStyle_Debug ) +import DynFlags ( DynFlags(..), hasPprDebug ) import Maybes ( orElse, catMaybes, isJust, isNothing ) import Demand import GHC.Serialized ( deserializeWithData ) @@ -1522,8 +1521,10 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs spec_count' = n_pats + spec_count ; case sc_count env of Just max | not (sc_force env) && spec_count' > max - -> if (debugIsOn || opt_PprStyle_Debug) -- Suppress this scary message for - then pprTrace "SpecConstr" msg $ -- ordinary users! Trac #5125 + -- Suppress this scary message for + -- ordinary users! Trac #5125 + -> if (debugIsOn || hasPprDebug (sc_dflags env)) + then pprTrace "SpecConstr" msg $ return (nullUsage, spec_info) else return (nullUsage, spec_info) where @@ -1533,8 +1534,10 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs text "but the limit is" <+> int max) ] , text "Use -fspec-constr-count=n to set the bound" , extra ] - extra | not opt_PprStyle_Debug = text "Use -dppr-debug to see specialisations" - | otherwise = text "Specialisations:" <+> ppr (pats ++ [p | OS p _ _ _ <- specs]) + extra = sdocWithPprDebug $ \dbg -> if dbg + then text "Specialisations:" + <+> ppr (pats ++ [p | OS p _ _ _ <- specs]) + else text "Use -dppr-debug to see specialisations" _normal_case -> do { |