diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2020-03-24 11:49:37 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-03-25 14:45:40 -0400 |
commit | 3e27205a66b06a4501d87eb31e285eadbc693eb7 (patch) | |
tree | d6fce48ea84322cf09b2079cd6a9633379cfbf48 /compiler | |
parent | 703221f408b023a1b3433938572e7b5c24b4af60 (diff) | |
download | haskell-3e27205a66b06a4501d87eb31e285eadbc693eb7.tar.gz |
Remove -fkill-absence and -fkill-one-shot flags
They seem to be a benchmarking vestige of the Cardinality paper and
probably shouldn't have been merged to HEAD in the first place.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Core/Op/DmdAnal.hs | 9 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 2 | ||||
-rw-r--r-- | compiler/basicTypes/Demand.hs | 33 |
3 files changed, 3 insertions, 41 deletions
diff --git a/compiler/GHC/Core/Op/DmdAnal.hs b/compiler/GHC/Core/Op/DmdAnal.hs index 57544519d3..eb9f277f8a 100644 --- a/compiler/GHC/Core/Op/DmdAnal.hs +++ b/compiler/GHC/Core/Op/DmdAnal.hs @@ -603,7 +603,7 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- TODO: Won't the following line unnecessarily trim down arity for join -- points returning a lambda in a C(S) context? sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = setIdStrictness id sig -- See Note [NOINLINE and strictness] @@ -1171,8 +1171,7 @@ findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand) findBndrDmd env arg_of_dfun dmd_ty id = (dmd_ty', dmd') where - dmd' = killUsageDemand (ae_dflags env) $ - strictify $ + dmd' = strictify $ trimToType starting_dmd (findTypeShape fam_envs id_ty) (dmd_ty', starting_dmd) = peelFV dmd_ty id @@ -1191,10 +1190,6 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) - {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See section 9.2 (Finding fixpoints) of the paper. diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index bdb8daebce..cf9b84dcf4 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -3568,8 +3568,6 @@ fFlagsDeps = [ flagGhciSpec "implicit-import-qualified" Opt_ImplicitImportQualified, flagSpec "irrefutable-tuples" Opt_IrrefutableTuples, flagSpec "keep-going" Opt_KeepGoing, - flagSpec "kill-absence" Opt_KillAbsence, - flagSpec "kill-one-shot" Opt_KillOneShot, flagSpec "late-dmd-anal" Opt_LateDmdAnal, flagSpec "late-specialise" Opt_LateSpecialise, flagSpec "liberate-case" Opt_LiberateCase, diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs index 196bedb8ee..28282d4382 100644 --- a/compiler/basicTypes/Demand.hs +++ b/compiler/basicTypes/Demand.hs @@ -50,7 +50,7 @@ module Demand ( TypeShape(..), peelTsFuns, trimToType, useCount, isUsedOnce, reuseEnv, - killUsageDemand, killUsageSig, zapUsageDemand, zapUsageEnvSig, + zapUsageDemand, zapUsageEnvSig, zapUsedOnceDemand, zapUsedOnceSig, strictifyDictDmd, strictifyDmd @@ -60,7 +60,6 @@ module Demand ( import GhcPrelude -import GHC.Driver.Session import Outputable import Var ( Var ) import VarEnv @@ -1754,14 +1753,6 @@ that it is going to diverge. This is the reason why we use the function appIsBottom, which, given a strictness signature and a number of arguments, says conservatively if the function is going to diverge or not. - -Zap absence or one-shot information, under control of flags - -Note [Killing usage information] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The flags -fkill-one-shot and -fkill-absence let you switch off the generation -of absence or one-shot information altogether. This is only used for performance -tests, to see how important they are. -} zapUsageEnvSig :: StrictSig -> StrictSig @@ -1790,34 +1781,12 @@ zapUsedOnceSig :: StrictSig -> StrictSig zapUsedOnceSig (StrictSig (DmdType env ds r)) = StrictSig (DmdType env (map zapUsedOnceDemand ds) r) -killUsageDemand :: DynFlags -> Demand -> Demand --- See Note [Killing usage information] -killUsageDemand dflags dmd - | Just kfs <- killFlags dflags = kill_usage kfs dmd - | otherwise = dmd - -killUsageSig :: DynFlags -> StrictSig -> StrictSig --- See Note [Killing usage information] -killUsageSig dflags sig@(StrictSig (DmdType env ds r)) - | Just kfs <- killFlags dflags = StrictSig (DmdType env (map (kill_usage kfs) ds) r) - | otherwise = sig - data KillFlags = KillFlags { kf_abs :: Bool , kf_used_once :: Bool , kf_called_once :: Bool } -killFlags :: DynFlags -> Maybe KillFlags --- See Note [Killing usage information] -killFlags dflags - | not kf_abs && not kf_used_once = Nothing - | otherwise = Just (KillFlags {..}) - where - kf_abs = gopt Opt_KillAbsence dflags - kf_used_once = gopt Opt_KillOneShot dflags - kf_called_once = kf_used_once - kill_usage :: KillFlags -> Demand -> Demand kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u} |