From 61a00ea28c26af3763782dea7f93c3b1f778de7d Mon Sep 17 00:00:00 2001
From: Twan van Laarhoven <twanvl@gmail.com>
Date: Sat, 26 Jan 2008 22:10:10 +0000
Subject: [PATCH] Fixed warnings in stgSyn/StgSyn

---
 compiler/stgSyn/StgSyn.lhs |   43 +++++++++++++++++++++++--------------------
 1 file changed, 23 insertions(+), 20 deletions(-)

diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 6cd7df7..893358b 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -9,13 +9,6 @@ form of @CoreSyntax@, the style being one that happens to be ideally
 suited to spineless tagless code generation.
 
 \begin{code}
-{-# 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
-
 module StgSyn (
 	GenStgArg(..), 
 	GenStgLiveVars,
@@ -69,7 +62,7 @@ import Outputable
 import Util             ( count )
 import Type             ( Type )
 import TyCon            ( TyCon )
-import UniqSet		( isEmptyUniqSet, uniqSetToList, UniqSet )
+import UniqSet
 import Unique		( Unique )
 import Bitmap
 import StaticFlags	( opt_SccProfilingOn )
@@ -109,14 +102,14 @@ data GenStgArg occ
 \end{code}
 
 \begin{code}
+isStgTypeArg :: StgArg -> Bool
 isStgTypeArg (StgTypeArg _) = True
-isStgTypeArg other	    = False
+isStgTypeArg _              = False
 
 isDllArg :: PackageId -> StgArg -> Bool
 	-- Does this argument refer to something in a different DLL?
-isDllArg this_pkg (StgTypeArg v)  = False
-isDllArg this_pkg (StgVarArg v)   = isDllName this_pkg (idName v)
-isDllArg this_pkg (StgLitArg lit) = False
+isDllArg this_pkg (StgVarArg v)  = isDllName this_pkg (idName v)
+isDllArg _        _              = False
 
 isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
 	-- Does this constructor application refer to 
@@ -129,7 +122,7 @@ stgArgType :: StgArg -> Type
 	-- Very half baked becase we have lost the type arguments
 stgArgType (StgVarArg v)   = idType v
 stgArgType (StgLitArg lit) = literalType lit
-stgArgType (StgTypeArg lit) = panic "stgArgType called on stgTypeArg"
+stgArgType (StgTypeArg _)  = panic "stgArgType called on stgTypeArg"
 \end{code}
 
 %************************************************************************
@@ -436,11 +429,13 @@ stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
 stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
 stgBindHasCafRefs (StgRec binds)    = any rhsHasCafRefs (map snd binds)
 
+rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
 rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _) 
   = isUpdatable upd || nonEmptySRT srt
 rhsHasCafRefs (StgRhsCon _ _ args)
   = any stgArgHasCafRefs args
 
+stgArgHasCafRefs :: GenStgArg Id -> Bool
 stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
 stgArgHasCafRefs _ = False
 \end{code}
@@ -454,6 +449,7 @@ data StgBinderInfo
 			-- slow entry code for the thing
 			-- Thunks never get this value
 
+noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
 noBinderInfo = NoStgBinderInfo
 stgUnsatOcc  = NoStgBinderInfo
 stgSatOcc    = SatCallsOnly
@@ -464,9 +460,10 @@ satCallsOnly NoStgBinderInfo = False
 
 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
 combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
-combineStgBinderInfo info1 info2 	       = NoStgBinderInfo
+combineStgBinderInfo _            _            = NoStgBinderInfo
 
 --------------
+pp_binder_info :: StgBinderInfo -> SDoc
 pp_binder_info NoStgBinderInfo = empty
 pp_binder_info SatCallsOnly    = ptext SLIT("sat-only")
 \end{code}
@@ -543,6 +540,7 @@ instance Outputable UpdateFlag where
     ppr u
       = char (case u of { ReEntrant -> 'r';  Updatable -> 'u';  SingleEntry -> 's' })
 
+isUpdatable :: UpdateFlag -> Bool
 isUpdatable ReEntrant   = False
 isUpdatable SingleEntry = False
 isUpdatable Updatable   = True
@@ -588,16 +586,15 @@ data SRT = NoSRT
          | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
 		-- generated by computeSRTs
 
-noSRT :: SRT
-noSRT = NoSRT
-
+nonEmptySRT :: SRT -> Bool
 nonEmptySRT NoSRT           = False
 nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
 nonEmptySRT _               = True
 
-pprSRT (NoSRT) = ptext SLIT("_no_srt_")
+pprSRT :: SRT -> SDoc
+pprSRT (NoSRT)          = ptext SLIT("_no_srt_")
 pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
-pprSRT (SRT off length bitmap) = parens (ppr off <> comma <> text "*bitmap*")
+pprSRT (SRT off _ _)    = parens (ppr off <> comma <> text "*bitmap*")
 \end{code}
 
 %************************************************************************
@@ -762,10 +759,13 @@ pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
 	   nest 2 (vcat (map pprStgAlt alts)),
 	   char '}']
 
-pprStgAlt (con, params, use_mask, expr)
+pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
+          => GenStgAlt bndr occ -> SDoc
+pprStgAlt (con, params, _use_mask, expr)
   = hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
 	 4 (ppr expr <> semi)
 
+pprStgOp :: StgOp -> SDoc
 pprStgOp (StgPrimOp  op)   = ppr op
 pprStgOp (StgFCallOp op _) = ppr op
 
@@ -777,6 +777,7 @@ instance Outputable AltType where
 \end{code}
 
 \begin{code}
+#ifdef DEBUG
 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
 pprStgLVs lvs
   = getPprStyle $ \ sty ->
@@ -784,6 +785,7 @@ pprStgLVs lvs
 	empty
     else
 	hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
+#endif
 \end{code}
 
 \begin{code}
@@ -809,6 +811,7 @@ pprStgRhs (StgRhsCon cc con args)
   = hcat [ ppr cc,
 	   space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
 
+pprMaybeSRT :: SRT -> SDoc
 pprMaybeSRT (NoSRT) = empty
 pprMaybeSRT srt     = ptext SLIT("srt:") <> pprSRT srt
 \end{code}
-- 
1.7.10.4