diff options
Diffstat (limited to 'compiler/hsSyn/HsPat.hs')
| -rw-r--r-- | compiler/hsSyn/HsPat.hs | 25 |
1 files changed, 14 insertions, 11 deletions
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs index ec5578f36d..853e8cb70d 100644 --- a/compiler/hsSyn/HsPat.hs +++ b/compiler/hsSyn/HsPat.hs @@ -409,7 +409,8 @@ hsRecUpdFieldOcc = fmap unambiguousFieldOcc . hsRecFieldLbl ************************************************************************ -} -instance (OutputableBndrId name) => Outputable (Pat name) where +instance (OutputableBndrId name, HasOccNameId name) + => Outputable (Pat name) where ppr = pprPat pprPatBndr :: OutputableBndr name => name -> SDoc @@ -421,10 +422,11 @@ pprPatBndr var -- Print with type info if -dppr-debug is on else pprPrefixOcc var -pprParendLPat :: (OutputableBndrId name) => LPat name -> SDoc +pprParendLPat :: (OutputableBndrId name, HasOccNameId name) + => LPat name -> SDoc pprParendLPat (L _ p) = pprParendPat p -pprParendPat :: (OutputableBndrId name) => Pat name -> SDoc +pprParendPat :: (OutputableBndrId name, HasOccNameId name) => Pat name -> SDoc pprParendPat p = sdocWithDynFlags $ \ dflags -> if need_parens dflags p then parens (pprPat p) @@ -438,7 +440,7 @@ pprParendPat p = sdocWithDynFlags $ \ dflags -> -- But otherwise the CoPat is discarded, so it -- is the pattern inside that matters. Sigh. -pprPat :: (OutputableBndrId name) => Pat name -> SDoc +pprPat :: (OutputableBndrId name, HasOccNameId name) => Pat name -> SDoc pprPat (VarPat (L _ var)) = pprPatBndr var pprPat (WildPat _) = char '_' pprPat (LazyPat pat) = char '~' <> pprParendLPat pat @@ -475,12 +477,13 @@ pprPat (ConPatOut { pat_con = con, pat_tvs = tvs, pat_dicts = dicts, else pprUserCon (unLoc con) details -pprUserCon :: (OutputableBndr con, OutputableBndrId id) +pprUserCon :: (OutputableBndr con, OutputableBndrId id, HasOccNameId id) => con -> HsConPatDetails id -> SDoc pprUserCon c (InfixCon p1 p2) = ppr p1 <+> pprInfixOcc c <+> ppr p2 pprUserCon c details = pprPrefixOcc c <+> pprConArgs details -pprConArgs :: (OutputableBndrId id) => HsConPatDetails id -> SDoc +pprConArgs :: (OutputableBndrId id, HasOccNameId id) + => HsConPatDetails id -> SDoc pprConArgs (PrefixCon pats) = sep (map pprParendLPat pats) pprConArgs (InfixCon p1 p2) = sep [pprParendLPat p1, pprParendLPat p2] pprConArgs (RecCon rpats) = ppr rpats @@ -519,7 +522,7 @@ mkPrefixConPat dc pats tys mkNilPat :: Type -> OutPat id mkNilPat ty = mkPrefixConPat nilDataCon [] [ty] -mkCharLitPat :: String -> Char -> OutPat id +mkCharLitPat :: SourceText -> Char -> OutPat id mkCharLitPat src c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim src c)] [] @@ -595,7 +598,7 @@ looksLazyLPat (L _ (VarPat {})) = False looksLazyLPat (L _ (WildPat {})) = False looksLazyLPat _ = True -isIrrefutableHsPat :: (OutputableBndrId id) => LPat id -> Bool +isIrrefutableHsPat :: (OutputableBndrId id, HasOccNameId id) => LPat id -> Bool -- (isIrrefutableHsPat p) is true if matching against p cannot fail, -- in the sense of falling through to the next pattern. -- (NB: this is not quite the same as the (silly) defn @@ -670,9 +673,9 @@ hsPatNeedsParens (LitPat {}) = False hsPatNeedsParens (NPat {}) = False conPatNeedsParens :: HsConDetails a b -> Bool -conPatNeedsParens (PrefixCon args) = not (null args) -conPatNeedsParens (InfixCon {}) = True -conPatNeedsParens (RecCon {}) = True +conPatNeedsParens (PrefixCon {}) = False +conPatNeedsParens (InfixCon {}) = True +conPatNeedsParens (RecCon {}) = False {- % Collect all EvVars from all constructor patterns |