Fix warnings in main/PprTyThing

1 files changed, 27 insertions, 17 deletions

diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index c379d972d9..16f5181af8 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -1,10 +1,3 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 -----------------------------------------------------------------------------
 --
 -- Pretty-printing TyThings
@@ -27,14 +20,14 @@ module PprTyThing (
 
 import qualified GHC
 
-import GHC	( TyThing(..) )
-import TyCon	( tyConFamInst_maybe, isAlgTyCon, tyConStupidTheta )
-import Type	( TyThing(..), tidyTopType, pprTypeApp )
-import TcType	( tcMultiSplitSigmaTy, mkPhiTy )
-import SrcLoc	( SrcSpan )
+import GHC ( TyThing(..) )
+import TyCon
+import Type ( TyThing(..), tidyTopType, pprTypeApp )
+import TcType
 import Var
 import Name
 import Outputable
+import Pretty ( Doc )
 
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
@@ -81,9 +74,10 @@ pprTyThingHdr pefas (AnId id)          = pprId         pefas id
 pprTyThingHdr pefas (ADataCon dataCon) = pprDataConSig pefas dataCon
 pprTyThingHdr pefas (ATyCon tyCon)     = pprTyConHdr   pefas tyCon
 pprTyThingHdr pefas (AClass cls)       = pprClassHdr   pefas cls
-        
-pprTyConHdr pefas tyCon
-  | Just (fam_tc, tys) <- tyConFamInst_maybe tyCon
+
+pprTyConHdr :: PrintExplicitForalls -> TyCon -> PprStyle -> Doc
+pprTyConHdr _ tyCon
+  | Just (_fam_tc, tys) <- tyConFamInst_maybe tyCon
   = ptext keyword <+> ptext SLIT("instance") <+> pprTypeApp tyCon (ppr_bndr tyCon) tys
   | otherwise
   = ptext keyword <+> opt_family <+> opt_stupid <+> ppr_bndr tyCon <+> hsep (map ppr vars)
@@ -104,10 +98,12 @@ pprTyConHdr pefas tyCon
 	| isAlgTyCon tyCon = GHC.pprThetaArrow (tyConStupidTheta tyCon)
 	| otherwise	   = empty	-- Returns 'empty' if null theta
 
+pprDataConSig :: PrintExplicitForalls -> GHC.DataCon -> PprStyle -> Doc
 pprDataConSig pefas dataCon =
   ppr_bndr dataCon <+> dcolon <+> pprTypeForUser pefas (GHC.dataConType dataCon)
 
-pprClassHdr pefas cls =
+pprClassHdr :: PrintExplicitForalls -> GHC.Class -> PprStyle -> Doc
+pprClassHdr _ cls =
   let (tyVars, funDeps) = GHC.classTvsFds cls
   in ptext SLIT("class") <+> 
      GHC.pprThetaArrow (GHC.classSCTheta cls) <+>
@@ -115,11 +111,13 @@ pprClassHdr pefas cls =
      hsep (map ppr tyVars) <+>
      GHC.pprFundeps funDeps
 
+pprIdInContext :: PrintExplicitForalls -> Var -> PprStyle -> Doc
 pprIdInContext pefas id
   | GHC.isRecordSelector id  		  = pprRecordSelector pefas id
   | Just cls <- GHC.isClassOpId_maybe id  = pprClassOneMethod pefas cls id
   | otherwise				  = pprId pefas id
 
+pprRecordSelector :: PrintExplicitForalls -> Id -> PprStyle -> Doc
 pprRecordSelector pefas id
   = pprAlgTyCon pefas tyCon show_con show_label
   where
@@ -148,6 +146,7 @@ pprTypeForUser print_foralls ty
     tidy_ty     = tidyTopType ty
     (ctxt, ty') = tcMultiSplitSigmaTy tidy_ty
 
+pprTyCon :: PrintExplicitForalls -> TyCon -> PprStyle -> Doc
 pprTyCon pefas tyCon
   | GHC.isSynTyCon tyCon
   = if GHC.isOpenTyCon tyCon
@@ -159,6 +158,9 @@ pprTyCon pefas tyCon
   | otherwise
   = pprAlgTyCon pefas tyCon (const True) (const True)
 
+pprAlgTyCon :: PrintExplicitForalls -> TyCon -> (GHC.DataCon -> Bool)
+            -> (FieldLabel -> Bool) -> PprStyle
+            -> Doc
 pprAlgTyCon pefas tyCon ok_con ok_label
   | gadt      = pprTyConHdr pefas tyCon <+> ptext SLIT("where") $$ 
 		   nest 2 (vcat (ppr_trim show_con datacons))
@@ -172,10 +174,14 @@ pprAlgTyCon pefas tyCon ok_con ok_label
       | ok_con dataCon = Just (pprDataConDecl pefas gadt ok_label dataCon)
       | otherwise      = Nothing
 
+pprDataCon :: PrintExplicitForalls -> GHC.DataCon -> PprStyle -> Doc
 pprDataCon pefas dataCon = pprAlgTyCon pefas tyCon (== dataCon) (const True)
   where tyCon = GHC.dataConTyCon dataCon
 
-pprDataConDecl pefas gadt_style show_label dataCon
+pprDataConDecl :: PrintExplicitForalls -> Bool -> (FieldLabel -> Bool)
+               -> GHC.DataCon -> PprStyle
+               -> Doc
+pprDataConDecl _ gadt_style show_label dataCon
   | not gadt_style = ppr_fields tys_w_strs
   | otherwise      = ppr_bndr dataCon <+> dcolon <+> 
 			sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ]
@@ -219,6 +225,7 @@ pprDataConDecl pefas gadt_style show_label dataCon
 		braces (sep (punctuate comma (ppr_trim maybe_show_label 
 					(zip labels fields))))
 
+pprClass :: PrintExplicitForalls -> GHC.Class -> PprStyle -> Doc
 pprClass pefas cls
   | null methods = 
 	pprClassHdr pefas cls
@@ -228,6 +235,7 @@ pprClass pefas cls
   where
 	methods = GHC.classMethods cls
 
+pprClassOneMethod :: PrintExplicitForalls -> GHC.Class -> Id -> PprStyle -> Doc
 pprClassOneMethod pefas cls this_one
   = hang (pprClassHdr pefas cls <+> ptext SLIT("where"))
 	 2 (vcat (ppr_trim show_meth methods))
@@ -236,6 +244,7 @@ pprClassOneMethod pefas cls this_one
 	show_meth id | id == this_one = Just (pprClassMethod pefas id)
 		     | otherwise      = Nothing
 
+pprClassMethod :: PrintExplicitForalls -> Id -> PprStyle -> Doc
 pprClassMethod pefas id
   = hang (ppr_bndr id <+> dcolon) 2 (pprTypeForUser pefas op_ty)
   where
@@ -263,6 +272,7 @@ ppr_trim show xs
 	| otherwise = if eliding then (True, so_far)
 		                 else (True, ptext SLIT("...") : so_far)
 
+add_bars :: [SDoc] -> PprStyle -> Doc
 add_bars []      = empty
 add_bars [c]     = equals <+> c
 add_bars (c:cs)  = sep ((equals <+> c) : map (char '|' <+>) cs)