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)