diff options
Diffstat (limited to 'compiler/GHC/Hs/Expr.hs')
| -rw-r--r-- | compiler/GHC/Hs/Expr.hs | 25 |
1 files changed, 13 insertions, 12 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 1ebacb8314..87c69f8a8e 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -2402,9 +2402,9 @@ pprStmt (LastStmt _ expr m_dollar_stripped _) Just False -> text "return" Nothing -> empty) <+> ppr expr -pprStmt (BindStmt _ pat expr) = hsep [ppr pat, larrow, ppr expr] +pprStmt (BindStmt _ pat expr) = pprBindStmt pat expr pprStmt (LetStmt _ (L _ binds)) = hsep [text "let", pprBinds binds] -pprStmt (BodyStmt _ expr _ _) = ppr expr +pprStmt (BodyStmt _ expr _ _) = pprBodyStmt expr pprStmt (ParStmt _ stmtss _ _) = sep (punctuate (text " | ") (map ppr stmtss)) pprStmt (TransStmt { trS_stmts = stmts, trS_by = by @@ -2439,10 +2439,9 @@ pprStmt (ApplicativeStmt _ args mb_join) flattenArg :: forall a . (a, ApplicativeArg (GhcPass idL)) -> [SDoc] flattenArg (_, ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - [ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL))] + [pprBodyStmt expr] | otherwise = - [ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL))] + [pprBindStmt pat expr] flattenArg (_, ApplicativeArgMany _ stmts _ _ _) = concatMap flattenStmt stmts @@ -2456,6 +2455,11 @@ pprStmt (ApplicativeStmt _ args mb_join) pp_arg :: (a, ApplicativeArg (GhcPass idL)) -> SDoc pp_arg (_, applicativeArg) = ppr applicativeArg +pprBodyStmt :: Outputable expr => expr -> SDoc +pprBodyStmt expr = ppr expr + +pprBindStmt :: (Outputable pat, Outputable expr) => pat -> expr -> SDoc +pprBindStmt pat expr = hsep [ppr pat, larrow, ppr expr] instance (OutputableBndrId idL) => Outputable (ApplicativeArg (GhcPass idL)) where @@ -2464,17 +2468,14 @@ instance (OutputableBndrId idL) pprArg :: forall idL . (OutputableBndrId idL) => ApplicativeArg (GhcPass idL) -> SDoc pprArg (ApplicativeArgOne _ pat expr isBody) | isBody = -- See Note [Applicative BodyStmt] - ppr (BodyStmt (panic "pprStmt") expr noSyntaxExpr noSyntaxExpr - :: ExprStmt (GhcPass idL)) + pprBodyStmt expr | otherwise = - ppr (BindStmt (panic "pprStmt") pat expr :: ExprStmt (GhcPass idL)) + pprBindStmt pat expr pprArg (ApplicativeArgMany _ stmts return pat ctxt) = ppr pat <+> text "<-" <+> - ppr (HsDo (panic "pprStmt") ctxt (noLoc - (stmts ++ - [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)])) - :: HsExpr (GhcPass idL)) + pprDo ctxt (stmts ++ + [noLoc (LastStmt noExtField (noLoc return) Nothing noSyntaxExpr)]) pprTransformStmt :: (OutputableBndrId p) => [IdP (GhcPass p)] -> LHsExpr (GhcPass p) |