X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FPprCore.lhs;h=84bf8689c60cdc49c7cda5ae709daf0932941fa3;hp=d641a9e833140f8e900d69f31057e50c4c81a835;hb=f96194794bf099020706c3816d1a5678b40addbb;hpb=7e8cba32c6f045dde3db8a9ddc9831ec8ab4ed43 diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index d641a9e..84bf868 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -27,6 +27,7 @@ import DataCon import TyCon import Type import Coercion +import StaticFlags import BasicTypes import Util import Outputable @@ -70,13 +71,16 @@ pprTopBinds binds = vcat (map pprTopBind binds) pprTopBind :: OutputableBndr a => Bind a -> SDoc pprTopBind (NonRec binder expr) - = ppr_binding (binder,expr) $$ text "" + = ppr_binding (binder,expr) $$ blankLine -pprTopBind (Rec binds) +pprTopBind (Rec []) + = ptext (sLit "Rec { }") +pprTopBind (Rec (b:bs)) = vcat [ptext (sLit "Rec {"), - vcat (map ppr_binding binds), + ppr_binding b, + vcat [blankLine $$ ppr_binding b | b <- bs], ptext (sLit "end Rec }"), - text ""] + blankLine] \end{code} \begin{code} @@ -114,9 +118,11 @@ ppr_expr _ (Lit lit) = ppr lit ppr_expr add_par (Cast expr co) = add_par $ sep [pprParendExpr expr, - ptext (sLit "`cast`") <+> parens (pprCo co)] + ptext (sLit "`cast`") <+> pprCo co] where - pprCo co = sep [ppr co, dcolon <+> ppr (coercionKindPredTy co)] + pprCo co | opt_SuppressCoercions = ptext (sLit "...") + | otherwise = parens + $ sep [ppr co, dcolon <+> ppr (coercionKindPredTy co)] ppr_expr add_par expr@(Lam _ _) @@ -250,7 +256,7 @@ pprCoreBinder :: BindingSite -> Var -> SDoc pprCoreBinder LetBind binder | isTyVar binder = pprKindedTyVarBndr binder | otherwise - = vcat [sig, pprIdDetails binder, pragmas] + = vcat [sig, pprIdExtras binder, pragmas] where sig = pprTypedBinder binder pragmas = ppIdInfo binder (idInfo binder) @@ -310,7 +316,7 @@ pprIdBndrInfo info dmd_info = newDemandInfo info lbv_info = lbvarInfo info - no_info = isAlwaysActive prag_info && isNoOcc occ_info && + no_info = isDefaultInlinePragma prag_info && isNoOcc occ_info && (case dmd_info of { Nothing -> True; Just d -> isTop d }) && hasNoLBVarInfo lbv_info @@ -326,10 +332,12 @@ pprIdBndrInfo info \begin{code} -pprIdDetails :: Id -> SDoc -pprIdDetails id | isGlobalId id = ppr (globalIdDetails id) - | isExportedId id = ptext (sLit "[Exported]") - | otherwise = empty +pprIdExtras :: Id -> SDoc +pprIdExtras id = pp_scope <> ppr (idDetails id) + where + pp_scope | isGlobalId id = ptext (sLit "GblId") + | isExportedId id = ptext (sLit "LclIdX") + | otherwise = ptext (sLit "LclId") ppIdInfo :: Id -> IdInfo -> SDoc ppIdInfo _ info