Commit ecb1752f authored by Christiaan Baaij's avatar Christiaan Baaij Committed by Ben Gamari
Browse files

Make -fcpr-off a dynamic flag

Test Plan: validate

Reviewers: austin, goldfire, simonpj, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D1110

GHC Trac Issues: #10706
parent 60297486
......@@ -57,7 +57,6 @@ module Demand (
#include "HsVersions.h"
import StaticFlags
import DynFlags
import Outputable
import Var ( Var )
......@@ -871,18 +870,13 @@ topRes = Dunno NoCPR
botRes = Diverges
cprSumRes :: ConTag -> DmdResult
cprSumRes tag | opt_CprOff = topRes
| otherwise = Dunno $ RetSum tag
cprSumRes tag = Dunno $ RetSum tag
cprProdRes :: [DmdType] -> DmdResult
cprProdRes _arg_tys
| opt_CprOff = topRes
| otherwise = Dunno $ RetProd
cprProdRes _arg_tys = Dunno $ RetProd
vanillaCprProdRes :: Arity -> DmdResult
vanillaCprProdRes _arity
| opt_CprOff = topRes
| otherwise = Dunno $ RetProd
vanillaCprProdRes _arity = Dunno $ RetProd
isTopRes :: DmdResult -> Bool
isTopRes (Dunno NoCPR) = True
......
......@@ -378,6 +378,7 @@ data GeneralFlag
| Opt_DictsStrict -- be strict in argument dictionaries
| Opt_DmdTxDictSel -- use a special demand transformer for dictionary selectors
| Opt_Loopification -- See Note [Self-recursive tail calls]
| Opt_CprAnal
-- Interface files
| Opt_IgnoreInterfacePragmas
......@@ -2965,6 +2966,7 @@ fFlags = [
flagSpec "cmm-elim-common-blocks" Opt_CmmElimCommonBlocks,
flagSpec "cmm-sink" Opt_CmmSink,
flagSpec "cse" Opt_CSE,
flagSpec "cpr-anal" Opt_CprAnal,
flagSpec "defer-type-errors" Opt_DeferTypeErrors,
flagSpec "defer-typed-holes" Opt_DeferTypedHoles,
flagSpec "dicts-cheap" Opt_DictsCheap,
......@@ -3357,6 +3359,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
, ([1,2], Opt_CrossModuleSpecialise)
, ([1,2], Opt_Strictness)
, ([1,2], Opt_UnboxSmallStrictFields)
, ([1,2], Opt_CprAnal)
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
......
......@@ -27,7 +27,6 @@ module StaticFlags (
-- optimisation opts
opt_NoStateHack,
opt_CprOff,
opt_NoOptCoercion,
-- For the parser
......@@ -144,8 +143,7 @@ isStaticFlag f = f `elem` flagsStaticNames
flagsStaticNames :: [String]
flagsStaticNames = [
"fno-state-hack",
"fno-opt-coercion",
"fcpr-off"
"fno-opt-coercion"
]
-- We specifically need to discard static flags for clients of the
......@@ -158,7 +156,6 @@ discardStaticFlags :: [String] -> [String]
discardStaticFlags = filter (\x -> x `notElem` flags)
where flags = [ "-fno-state-hack"
, "-fno-opt-coercion"
, "-fcpr-off"
, "-dppr-debug"
, "-dno-debug-output"
]
......@@ -202,10 +199,6 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output")
opt_NoStateHack :: Bool
opt_NoStateHack = lookUp (fsLit "-fno-state-hack")
-- Switch off CPR analysis in the new demand analyser
opt_CprOff :: Bool
opt_CprOff = lookUp (fsLit "-fcpr-off")
opt_NoOptCoercion :: Bool
opt_NoOptCoercion = lookUp (fsLit "-fno-opt-coercion")
......
......@@ -136,7 +136,8 @@ mkWwBodies dflags fam_envs fun_ty demands res_info one_shots
; (useful1, work_args, wrap_fn_str, work_fn_str) <- mkWWstr dflags fam_envs wrap_args
-- Do CPR w/w. See Note [Always do CPR w/w]
; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty) <- mkWWcpr fam_envs res_ty res_info
; (useful2, wrap_fn_cpr, work_fn_cpr, cpr_res_ty)
<- mkWWcpr (gopt Opt_CprAnal dflags) fam_envs res_ty res_info
; let (work_lam_args, work_call_args) = mkWorkerArgs dflags work_args all_one_shots cpr_res_ty
worker_args_dmds = [idDemandInfo v | v <- work_call_args, isId v]
......@@ -601,7 +602,8 @@ The non-CPR results appear ordered in the unboxed tuple as if by a
left-to-right traversal of the result structure.
-}
mkWWcpr :: FamInstEnvs
mkWWcpr :: Bool
-> FamInstEnvs
-> Type -- function body type
-> DmdResult -- CPR analysis results
-> UniqSM (Bool, -- Is w/w'ing useful?
......@@ -609,7 +611,11 @@ mkWWcpr :: FamInstEnvs
CoreExpr -> CoreExpr, -- New worker
Type) -- Type of worker's body
mkWWcpr fam_envs body_ty res
mkWWcpr opt_CprAnal fam_envs body_ty res
-- CPR explicitly turned off (or in -O0)
| not opt_CprAnal = return (False, id, id, body_ty)
-- CPR is turned on by default for -O and O2
| otherwise
= case returnsCPR_maybe res of
Nothing -> return (False, id, id, body_ty) -- No CPR info
Just con_tag | Just stuff <- deepSplitCprType_maybe fam_envs con_tag body_ty
......
......@@ -112,6 +112,17 @@
type errors.
</para>
</listitem>
<listitem>
<para>
Added the option <option>-fcpr-anal</option>.
When enabled, the demand analyser performs CPR analysis.
It is implied by <option>-O</option>. Consequently,
<option>-fcpr-off</option> is now removed, run with
<option>-fno-cpr-anal</option> to get the old
<option>-fcpr-off</option> behaviour.
</para>
</listitem>
</itemizedlist>
</sect3>
......
......@@ -1967,10 +1967,11 @@
</row>
<row>
<entry><option>-fcpr-off</option></entry>
<entry>Switch off CPR analysis in the demand analyser.</entry>
<entry>static</entry>
<entry>-</entry>
<entry><option>-fcpr-anal</option></entry>
<entry>Turn on CPR analysis in the demand analyser. Implied by
<option>-O</option>.</entry>
<entry>dynamic</entry>
<entry><option>-fno-cpr-anal</option></entry>
</row>
<row>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment