diff options
Diffstat (limited to 'compiler/GHC/Core/Ppr.hs')
| -rw-r--r-- | compiler/GHC/Core/Ppr.hs | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs index c0b2749359..79c5acae23 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -161,15 +161,20 @@ pprOptCo co = sdocOption sdocSuppressCoercions $ \case True -> angleBrackets (text "Co:" <> int (coercionSize co)) False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)] +ppr_id_occ :: (SDoc -> SDoc) -> Id -> SDoc +ppr_id_occ add_par id + | isJoinId id = add_par ((text "jump") <+> pp_id) + | otherwise = pp_id + where + pp_id = ppr id -- We could use pprPrefixOcc to print (+) etc, but this is + -- Core where we don't print things infix anyway, so doing + -- so just adds extra redundant parens + ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc -- The function adds parens in context that need -- an atomic value (e.g. function args) -ppr_expr add_par (Var name) - | isJoinId name = add_par ((text "jump") <+> pp_name) - | otherwise = pp_name - where - pp_name = pprPrefixOcc name +ppr_expr add_par (Var id) = ppr_id_occ add_par id ppr_expr add_par (Type ty) = add_par (text "TYPE:" <+> ppr ty) -- Weird ppr_expr add_par (Coercion co) = add_par (text "CO:" <+> ppr co) ppr_expr add_par (Lit lit) = pprLiteral add_par lit @@ -212,8 +217,7 @@ ppr_expr add_par expr@(App {}) _ -> parens (hang fun_doc 2 pp_args) where - fun_doc | isJoinId f = text "jump" <+> ppr f - | otherwise = ppr f + fun_doc = ppr_id_occ noParens f _ -> parens (hang (pprParendExpr fun) 2 pp_args) } |