Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/02aef1122e64e21964a6e5f1d1ef01e5a0c64f44 >--------------------------------------------------------------- commit 02aef1122e64e21964a6e5f1d1ef01e5a0c64f44 Author: Ian Lynagh <[email protected]> Date: Thu Jun 14 17:18:27 2012 +0100 Make -dppr-case-as-let a dynamic flag >--------------------------------------------------------------- compiler/coreSyn/PprCore.lhs | 50 +++++++++++++++++++++--------------------- compiler/main/DynFlags.hs | 10 ++++++++ compiler/main/StaticFlags.hs | 5 ---- docs/users_guide/flags.xml | 2 +- 4 files changed, 36 insertions(+), 31 deletions(-) diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index be2948e..8ac0664 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/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 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index e198d47..8f3e126 100644 --- a/compiler/main/DynFlags.hs +++ b/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 = [ diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 06cf19d..c76059c 100644 --- a/compiler/main/StaticFlags.hs +++ b/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 diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index cd45040..db17084 100644 --- a/docs/users_guide/flags.xml +++ b/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> _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
