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

compiler/basicTypes/Demand.hs

@@ -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

compiler/main/DynFlags.hs

@@ -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)

compiler/main/StaticFlags.hs

@@ -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")
 

compiler/stranal/WwLib.hs

@@ -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

docs/users_guide/7.12.1-notes.xml

@@ -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>
 

docs/users_guide/flags.xml

@@ -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>