From 5699ec476d64d48b7fcf6812238406e1eea91bef Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sun, 4 May 2008 21:31:23 +0000
Subject: [PATCH] Make SimplEnv warning-free

---
 compiler/simplCore/SimplEnv.lhs |   30 +++++++++++-------------------
 1 file changed, 11 insertions(+), 19 deletions(-)

diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs
index 127e8cb..1c3b8d8 100644
--- a/compiler/simplCore/SimplEnv.lhs
+++ b/compiler/simplCore/SimplEnv.lhs
@@ -4,13 +4,6 @@
 \section[SimplMonad]{The simplifier Monad}
 
 \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 SimplEnv (
 	InId, InBind, InExpr, InAlt, InArg, InType, InBndr,
 	OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBndr,
@@ -49,7 +42,6 @@ module SimplEnv (
 import SimplMonad
 import IdInfo
 import CoreSyn
-import Rules
 import CoreUtils
 import CostCentre
 import Var
@@ -63,7 +55,6 @@ import Type hiding		( substTy, substTyVarBndr )
 import Coercion
 import BasicTypes	
 import DynFlags
-import Util
 import MonadUtils
 import Outputable
 import FastString
@@ -144,7 +135,7 @@ data SimplSR
 instance Outputable SimplSR where
   ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
   ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
-  ppr (ContEx tv id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
+  ppr (ContEx _tv _id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
 				ppr (filter_env tv), ppr (filter_env id) -}]
 	-- where
 	-- fvs = exprFreeVars e
@@ -352,7 +343,7 @@ instance Outputable FloatFlag where
 andFF :: FloatFlag -> FloatFlag -> FloatFlag
 andFF FltCareful _ 	    = FltCareful
 andFF FltOkSpec  FltCareful = FltCareful
-andFF FltOkSpec  flt	    = FltOkSpec
+andFF FltOkSpec  _  	    = FltOkSpec
 andFF FltLifted  flt	    = flt
 
 classifyFF :: CoreBind -> FloatFlag
@@ -420,7 +411,7 @@ addRecFloats :: SimplEnv -> SimplEnv -> SimplEnv
 -- This is all very specific to the way recursive bindings are
 -- handled; see Simplify.simplRecBind
 addRecFloats env1 env2@(SimplEnv {seFloats = Floats bs ff})
-  = ASSERT2( case ff of { FltLifted -> True; other -> False }, ppr (fromOL bs) )
+  = ASSERT2( case ff of { FltLifted -> True; _ -> False }, ppr (fromOL bs) )
     env2 {seFloats = seFloats env1 `addFlts` unitFloat (Rec (flattenBinds (fromOL bs)))}
 
 wrapFloats :: SimplEnv -> OutExpr -> OutExpr
@@ -473,6 +464,7 @@ substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
 	-- Get the most up-to-date thing from the in-scope set
 	-- Even though it isn't in the substitution, it may be in
 	-- the in-scope set with better IdInfo
+refine :: InScopeSet -> Var -> Var
 refine in_scope v = case lookupInScope in_scope v of
 			 Just v' -> v'
 			 Nothing -> WARN( True, ppr v ) v	-- This is an error!
@@ -483,8 +475,8 @@ lookupRecBndr :: SimplEnv -> InId -> OutId
 lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v
   = case lookupVarEnv ids v of
 	Just (DoneId v) -> v
-	Just res	-> pprPanic "lookupRecBndr" (ppr v)
-	Nothing		-> refine in_scope v
+	Just _ -> pprPanic "lookupRecBndr" (ppr v)
+	Nothing -> refine in_scope v
 \end{code}
 
 
@@ -543,7 +535,7 @@ simplNonRecBndr env id
 ---------------
 simplRecBndrs :: SimplEnv -> [InBndr] -> SimplM SimplEnv
 -- Recursive let binders
-simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
+simplRecBndrs env@(SimplEnv {}) ids
   = do	{ let (env1, ids1) = mapAccumL substIdBndr env ids
 	; seqIds ids1 `seq` return env1 }
 
@@ -665,7 +657,7 @@ addBndrRules env in_id out_id
 
 ------------------
 substIdType :: SimplEnv -> Id -> Id
-substIdType env@(SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
+substIdType (SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
   | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
   | otherwise	= Id.setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
 		-- The tyVarsOfType is cheaper than it looks
@@ -676,14 +668,14 @@ substIdType env@(SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
 
 ------------------
 substUnfolding :: SimplEnv -> Unfolding -> Unfolding
-substUnfolding env NoUnfolding     	       = NoUnfolding
-substUnfolding env (OtherCon cons) 	       = OtherCon cons
+substUnfolding _   NoUnfolding     	       = NoUnfolding
+substUnfolding _   (OtherCon cons) 	       = OtherCon cons
 substUnfolding env (CompulsoryUnfolding rhs)   = CompulsoryUnfolding (substExpr env rhs)
 substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
 
 ------------------
 substWorker :: SimplEnv -> WorkerInfo -> WorkerInfo
-substWorker env NoWorker = NoWorker
+substWorker _   NoWorker = NoWorker
 substWorker env wkr_info = CoreSubst.substWorker (mkCoreSubst env) wkr_info
 \end{code}
 
-- 
1.7.10.4