Add more suppression flags

[ghc-hetmet.git] / compiler / coreSyn / PprCore.lhs

diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs
index 1908667..cc38837 100644 (file)
--- 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)
@@ -382,7 +389,7 @@ instance Outputable UnfoldingGuidance where
 instance Outputable UnfoldingSource where
   ppr InlineCompulsory  = ptext (sLit "Compulsory")
   ppr (InlineWrapper w) = ptext (sLit "Worker=") <> ppr w
-  ppr InlineRule        = ptext (sLit "InlineRule")
+  ppr InlineStable      = ptext (sLit "InlineStable")
   ppr InlineRhs         = ptext (sLit "<vanilla>")
 
 instance Outputable Unfolding where
@@ -407,8 +414,8 @@ instance Outputable Unfolding where
                 , ptext (sLit "Expandable=") <> ppr exp
                 , ptext (sLit "Guidance=")   <> ppr g ]
       pp_tmpl = ptext (sLit "Tmpl=") <+> ppr rhs
-      pp_rhs | isInlineRuleSource src = pp_tmpl
-             | otherwise              = empty
+      pp_rhs | isStableSource src = pp_tmpl
+             | otherwise          = empty
             -- Don't print the RHS or we get a quadratic 
            -- blowup in the size of the printout!
 \end{code}