[commit: ghc] master: Improve pretty-printing for CoPat (9195927)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9195927d093504e233225dfb40f2f6b95a78925e/ghc

>---------------------------------------------------------------

commit 9195927d093504e233225dfb40f2f6b95a78925e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Jun 24 22:19:33 2015 +0100

    Improve pretty-printing for CoPat


>---------------------------------------------------------------

9195927d093504e233225dfb40f2f6b95a78925e
 compiler/hsSyn/HsPat.hs | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 5d74edf..c146133 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -298,8 +298,17 @@ pprParendLPat :: (OutputableBndr name) => LPat name -> SDoc
 pprParendLPat (L _ p) = pprParendPat p
 
 pprParendPat :: (OutputableBndr name) => Pat name -> SDoc
-pprParendPat p | hsPatNeedsParens p = parens (pprPat p)
-               | otherwise          = pprPat p
+pprParendPat p = getPprStyle $ \ sty ->
+                 if need_parens sty p
+                 then parens (pprPat p)
+                 else  pprPat p
+  where
+    need_parens sty p
+      | CoPat {} <- p          -- In debug style we print the cast
+      , debugStyle sty = True  -- (see pprHsWrapper) so parens are needed
+      | otherwise      = hsPatNeedsParens p
+                         -- But otherwise the CoPat is discarded, so it
+                         -- is the pattern inside that matters.  Sigh.
 
 pprPat :: (OutputableBndr name) => Pat name -> SDoc
 pprPat (VarPat var)           = pprPatBndr var
@@ -495,7 +504,7 @@ hsPatNeedsParens p@(ConPatOut {})    = conPatNeedsParens (pat_args p)
 hsPatNeedsParens (SigPatIn {})       = True
 hsPatNeedsParens (SigPatOut {})      = True
 hsPatNeedsParens (ViewPat {})        = True
-hsPatNeedsParens (CoPat {})          = True
+hsPatNeedsParens (CoPat _ p _)       = hsPatNeedsParens p
 hsPatNeedsParens (WildPat {})        = False
 hsPatNeedsParens (VarPat {})         = False
 hsPatNeedsParens (LazyPat {})        = False