diff --git a/ghc/compiler/hsSyn/HsMatches.lhs b/ghc/compiler/hsSyn/HsMatches.lhs index ef370e330aa2932b5db986ec928292b86c234439..d4f4cae4f62b5154369e0c37cc08368509eeaa65 100644 --- a/ghc/compiler/hsSyn/HsMatches.lhs +++ b/ghc/compiler/hsSyn/HsMatches.lhs @@ -12,15 +12,19 @@ module HsMatches where IMP_Ubiq(){-uitous-} -IMPORT_DELOOPER(HsLoop) ( HsExpr, Stmt, nullBinds, HsBinds ) -import Outputable --( ifPprShowAll ) +-- Friends +import HsExpr ( HsExpr, Stmt ) +import HsBinds ( HsBinds, nullBinds ) + +-- Others +import Outputable ( ifPprShowAll, PprStyle ) import PprType ( GenType{-instance Outputable-} ) import Pretty import SrcLoc ( SrcLoc{-instances-} ) import Util ( panic ) +import Outputable ( Outputable(..) ) #if __GLASGOW_HASKELL__ >= 202 import Name -import PprStyle #endif \end{code} @@ -130,6 +134,10 @@ pprMatch sty is_case first_match ---------------------------------------------------------- +pprGRHSsAndBinds :: (NamedThing id, Outputable id, Outputable pat, + Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) => + PprStyle -> Bool -> GRHSsAndBinds tyvar uvar id pat -> Doc + pprGRHSsAndBinds sty is_case (GRHSsAndBindsIn grhss binds) = ($$) (vcat (map (pprGRHS sty is_case) grhss)) (if (nullBinds binds)