Improve pretty-printing for CoPat
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 24 Jun 2015 21:19:33 +0000 (22:19 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 26 Jun 2015 07:33:03 +0000 (08:33 +0100)
compiler/hsSyn/HsPat.hs

index 5d74edf..c146133 100644 (file)
@@ -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