Make -dppr-case-as-let a dynamic flag

compiler/coreSyn/PprCore.lhs

@@ -23,6 +23,7 @@ import DataCon
 import TyCon
 import Type
 import Coercion
+import DynFlags
 import StaticFlags
 import BasicTypes
 import Util
@@ -153,31 +154,30 @@ ppr_expr add_par expr@(App {})
     }
 
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
-  | opt_PprCaseAsLet
-  = add_par $
-    sep [sep    [ ptext (sLit "let")
-                        <+> char '{'
-                        <+> ppr_case_pat con args
-                        <+> ptext (sLit "~")
-                        <+> ppr_bndr var
-                , ptext (sLit "<-")
-                        <+> ppr_expr id expr
-                , char '}'
-                        <+> ptext (sLit "in")
-                ]
-        , pprCoreExpr rhs
-        ]
-
-  | otherwise
-  = add_par $
-    sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
-              ifPprDebug (braces (ppr ty)),
-              sep [ptext (sLit "of") <+> ppr_bndr var,
-                   char '{' <+> ppr_case_pat con args <+> arrow]
-          ],
-         pprCoreExpr rhs,
-         char '}'
-    ]
+  = sdocWithDynFlags $ \dflags ->
+    if dopt Opt_PprCaseAsLet dflags
+    then add_par $
+         sep [sep    [ ptext (sLit "let")
+                             <+> char '{'
+                             <+> ppr_case_pat con args
+                             <+> ptext (sLit "~")
+                             <+> ppr_bndr var
+                     , ptext (sLit "<-")
+                             <+> ppr_expr id expr
+                     , char '}'
+                             <+> ptext (sLit "in")
+                     ]
+             , pprCoreExpr rhs
+             ]
+    else add_par $
+         sep [sep [ptext (sLit "case") <+> pprCoreExpr expr,
+                   ifPprDebug (braces (ppr ty)),
+                   sep [ptext (sLit "of") <+> ppr_bndr var,
+                        char '{' <+> ppr_case_pat con args <+> arrow]
+               ],
+              pprCoreExpr rhs,
+              char '}'
+         ]
   where
     ppr_bndr = pprBndr CaseBind
 

compiler/main/DynFlags.hs

@@ -308,6 +308,9 @@ data DynFlag
    | Opt_HelpfulErrors
    | Opt_DeferTypeErrors
 
+   -- output style opts
+   | Opt_PprCaseAsLet
+
    -- temporary flags
    | Opt_RunCPS
    | Opt_RunCPSZ
@@ -1788,6 +1791,8 @@ dynamic_flags = [
   , Flag "fpackage-trust"   (NoArg setPackageTrust)
   , Flag "fno-safe-infer"   (NoArg (setSafeHaskell Sf_None))
  ]
+ ++ map (mkFlag turnOn  "d"    setDynFlag  ) dFlags
+ ++ map (mkFlag turnOff "dno-" unSetDynFlag) dFlags
  ++ map (mkFlag turnOn  "f"    setDynFlag  ) fFlags
  ++ map (mkFlag turnOff "fno-" unSetDynFlag) fFlags
  ++ map (mkFlag turnOn  "f"    setWarningFlag  ) fWarningFlags
@@ -1908,6 +1913,11 @@ fWarningFlags = [
   ( "warn-pointless-pragmas",           Opt_WarnPointlessPragmas, nop ),
   ( "warn-unsupported-calling-conventions", Opt_WarnUnsupportedCallingConventions, nop ) ]
 
+-- | These @-d\<blah\>@ flags can all be reversed with @-dno-\<blah\>@
+dFlags :: [FlagSpec DynFlag]
+dFlags = [
+  ( "ppr-case-as-let",                  Opt_PprCaseAsLet, nop ) ]
+
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
 fFlags :: [FlagSpec DynFlag]
 fFlags = [

compiler/main/StaticFlags.hs

@@ -28,7 +28,6 @@ module StaticFlags (
 
 	-- Output style options
 	opt_PprCols,
-	opt_PprCaseAsLet,
 	opt_PprStyle_Debug, opt_TraceLevel,
         opt_NoDebugOutput,
 
@@ -250,10 +249,6 @@ opt_SuppressUniques :: Bool
 opt_SuppressUniques
 	=  lookUp  (fsLit "-dsuppress-uniques")
 
--- | Display case expressions with a single alternative as strict let bindings
-opt_PprCaseAsLet :: Bool
-opt_PprCaseAsLet	= lookUp   (fsLit "-dppr-case-as-let")
-
 -- | Set the maximum width of the dumps
 --   If GHC's command line options are bad then the options parser uses the
 --   pretty printer display the error message. In this case the staticFlags

docs/users_guide/flags.xml

@@ -2724,7 +2724,7 @@
           <row>
             <entry><option>-dppr-case-as-let</option></entry>
             <entry>Print single alternative case expressions as strict lets.</entry>
-            <entry>static</entry>
+            <entry>dynamic</entry>
             <entry>-</entry>
           </row>
           <row>