diff options
| -rw-r--r-- | compiler/coreSyn/PprCore.lhs | 9 | ||||
| -rw-r--r-- | compiler/main/StaticFlagParser.hs | 21 | ||||
| -rw-r--r-- | compiler/main/StaticFlags.hs | 38 |
3 files changed, 54 insertions, 14 deletions
diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index 3752d1d5bd..cc3883767f 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -233,8 +233,13 @@ ppr_case_pat con args where ppr_bndr = pprBndr CaseBind + +-- | Pretty print the argument in a function application. pprArg :: OutputableBndr a => Expr a -> SDoc -pprArg (Type ty) = ptext (sLit "@") <+> pprParendType ty +pprArg (Type ty) + | opt_SuppressTypeApplications = empty + | otherwise = ptext (sLit "@") <+> pprParendType ty + pprArg expr = pprParendExpr expr \end{code} @@ -325,6 +330,8 @@ pprIdBndrInfo info \begin{code} ppIdInfo :: Id -> IdInfo -> SDoc ppIdInfo id info + | opt_SuppressIdInfo = empty + | otherwise = showAttributes [ (True, pp_scope <> ppr (idDetails id)) , (has_arity, ptext (sLit "Arity=") <> int arity) diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs index f7ad41f5a2..8de4c5c4ce 100644 --- a/compiler/main/StaticFlagParser.hs +++ b/compiler/main/StaticFlagParser.hs @@ -121,15 +121,18 @@ static_flags = [ -- is required to get the RTS ticky support. ------ Debugging ---------------------------------------------------- - , Flag "dppr-debug" (PassFlag addOpt) - , Flag "dsuppress-uniques" (PassFlag addOpt) - , Flag "dsuppress-coercions" (PassFlag addOpt) - , Flag "dsuppress-module-prefixes" (PassFlag addOpt) - , Flag "dppr-user-length" (AnySuffix addOpt) - , Flag "dopt-fuel" (AnySuffix addOpt) - , Flag "dtrace-level" (AnySuffix addOpt) - , Flag "dno-debug-output" (PassFlag addOpt) - , Flag "dstub-dead-values" (PassFlag addOpt) + , Flag "dppr-debug" (PassFlag addOpt) + , Flag "dsuppress-all" (PassFlag addOpt) + , Flag "dsuppress-uniques" (PassFlag addOpt) + , Flag "dsuppress-coercions" (PassFlag addOpt) + , Flag "dsuppress-module-prefixes" (PassFlag addOpt) + , Flag "dsuppress-type-applications" (PassFlag addOpt) + , Flag "dsuppress-idinfo" (PassFlag addOpt) + , Flag "dppr-user-length" (AnySuffix addOpt) + , Flag "dopt-fuel" (AnySuffix addOpt) + , Flag "dtrace-level" (AnySuffix addOpt) + , Flag "dno-debug-output" (PassFlag addOpt) + , Flag "dstub-dead-values" (PassFlag addOpt) -- rest of the debugging flags are dynamic ----- Linker -------------------------------------------------------- diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 5a43eb6632..9b8ea192f0 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -21,9 +21,12 @@ module StaticFlags ( -- Output style options opt_PprUserLength, + opt_SuppressAll, opt_SuppressUniques, opt_SuppressCoercions, opt_SuppressModulePrefixes, + opt_SuppressTypeApplications, + opt_SuppressIdInfo, opt_PprStyle_Debug, opt_TraceLevel, opt_NoDebugOutput, @@ -181,15 +184,42 @@ unpacked_opts = opt_IgnoreDotGhci :: Bool opt_IgnoreDotGhci = lookUp (fsLit "-ignore-dot-ghci") --- debugging opts +-- debugging options +-- | Suppress all that is suppressable in core dumps. +opt_SuppressAll :: Bool +opt_SuppressAll + = lookUp (fsLit "-dsuppress-all") + +-- | Suppress unique ids on variables. opt_SuppressUniques :: Bool -opt_SuppressUniques = lookUp (fsLit "-dsuppress-uniques") +opt_SuppressUniques + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-uniques") +-- | Suppress all coercions, them replacing with '...' opt_SuppressCoercions :: Bool -opt_SuppressCoercions = lookUp (fsLit "-dsuppress-coercions") +opt_SuppressCoercions + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-coercions") +-- | Suppress module id prefixes on variables. opt_SuppressModulePrefixes :: Bool -opt_SuppressModulePrefixes = lookUp (fsLit "-dsuppress-module-prefixes") +opt_SuppressModulePrefixes + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-module-prefixes") + +-- | Suppress type applications. +opt_SuppressTypeApplications :: Bool +opt_SuppressTypeApplications + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-type-applications") + +-- | Suppress info such as arity and unfoldings on identifiers. +opt_SuppressIdInfo :: Bool +opt_SuppressIdInfo + = lookUp (fsLit "-dsuppress-all") + || lookUp (fsLit "-dsuppress-idinfo") + opt_PprStyle_Debug :: Bool opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug") |