From a364279dac70162e4e22f7673c01642de6afaf6f Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Tue, 10 Jun 2008 12:18:19 +0000
Subject: [PATCH] Fix warnings in TcEnv

---
 compiler/typecheck/TcEnv.lhs |   34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 116056b..74eb195 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -3,13 +3,6 @@
 %
 
 \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 TcEnv(
 	TyThing(..), TcTyThing(..), TcId,
 
@@ -71,7 +64,6 @@ import FamInstEnv
 import DataCon
 import TyCon
 import TypeRep
-import Coercion
 import Class
 import Name
 import PrelNames
@@ -156,21 +148,21 @@ tcLookupDataCon name = do
     thing <- tcLookupGlobal name
     case thing of
 	ADataCon con -> return con
-	other	     -> wrongThingErr "data constructor" (AGlobal thing) name
+	_            -> wrongThingErr "data constructor" (AGlobal thing) name
 
 tcLookupClass :: Name -> TcM Class
 tcLookupClass name = do
     thing <- tcLookupGlobal name
     case thing of
 	AClass cls -> return cls
-	other	   -> wrongThingErr "class" (AGlobal thing) name
-	
+	_          -> wrongThingErr "class" (AGlobal thing) name
+
 tcLookupTyCon :: Name -> TcM TyCon
 tcLookupTyCon name = do
     thing <- tcLookupGlobal name
     case thing of
 	ATyCon tc -> return tc
-	other	  -> wrongThingErr "type constructor" (AGlobal thing) name
+	_         -> wrongThingErr "type constructor" (AGlobal thing) name
 
 tcLookupLocatedGlobalId :: Located Name -> TcM Id
 tcLookupLocatedGlobalId = addLocM tcLookupId
@@ -208,7 +200,7 @@ tcLookupFamInst tycon tys
        ; case lookupFamInstEnv instEnv tycon tys of
 	   [(fam_inst, rep_tys)] -> return $ Just (famInstTyCon fam_inst, 
                                                    rep_tys)
-	   other                 -> return Nothing
+	   _                     -> return Nothing
        }
 \end{code}
 
@@ -267,7 +259,7 @@ tcLookupTyVar name = do
     thing <- tcLookup name
     case thing of
 	ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
-	other	    -> pprPanic "tcLookupTyVar" (ppr name)
+	_           -> pprPanic "tcLookupTyVar" (ppr name)
 
 tcLookupId :: Name -> TcM Id
 -- Used when we aren't interested in the binding level, nor refinement. 
@@ -279,7 +271,7 @@ tcLookupId name = do
     case thing of
         ATcId { tct_id = id} -> return id
         AGlobal (AnId id)    -> return id
-        other                -> pprPanic "tcLookupId" (ppr name)
+        _                    -> pprPanic "tcLookupId" (ppr name)
 
 tcLookupLocalIds :: [Name] -> TcM [TcId]
 -- We expect the variables to all be bound, and all at
@@ -292,7 +284,7 @@ tcLookupLocalIds ns = do
 	= case lookupNameEnv lenv name of
 		Just (ATcId { tct_id = id, tct_level = lvl1 }) 
 			-> ASSERT( lvl == lvl1 ) id
-		other	-> pprPanic "tcLookupLocalIds" (ppr name)
+		_ -> pprPanic "tcLookupLocalIds" (ppr name)
 
 lclEnvElts :: TcLclEnv -> [TcTyThing]
 lclEnvElts env = nameEnvElts (tcl_env env)
@@ -431,6 +423,8 @@ findGlobals tvs tidy_env = do
     ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
 
 -----------------------
+find_thing :: (TcType -> Bool) -> TidyEnv -> TcTyThing
+           -> TcM (TidyEnv, Maybe SDoc)
 find_thing ignore_it tidy_env (ATcId { tct_id = id }) = do
     id_ty <- zonkTcType  (idType id)
     if ignore_it id_ty then
@@ -470,6 +464,7 @@ find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
 %************************************************************************
 
 \begin{code}
+tc_extend_gtvs :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
 tc_extend_gtvs gtvs extra_global_tvs = do
     global_tvs <- readMutVar gtvs
     newMutVar (global_tvs `unionVarSet` extra_global_tvs)
@@ -624,8 +619,10 @@ data InstBindings
 				-- witness dictionary is identical to the argument 
 				-- dictionary.  Hence no bindings, no pragmas.
 
+pprInstInfo :: InstInfo -> SDoc
 pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
 
+pprInstInfoDetails :: InstInfo -> SDoc
 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
   where
     details (VanillaInst b _) = pprLHsBinds b
@@ -633,7 +630,8 @@ pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
 
 simpleInstInfoClsTy :: InstInfo -> (Class, Type)
 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
-			  (_, _, cls, [ty]) -> (cls, ty)
+                           (_, _, cls, [ty]) -> (cls, ty)
+                           _ -> panic "simpleInstInfoClsTy"
 
 simpleInstInfoTy :: InstInfo -> Type
 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
@@ -689,12 +687,14 @@ pprBinders :: [Name] -> SDoc
 pprBinders [bndr] = quotes (ppr bndr)
 pprBinders bndrs  = pprWithCommas ppr bndrs
 
+notFound :: Name -> TcGblEnv -> TcM TyThing
 notFound name env
   = failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+> 
                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env env)]
                     )
 
+wrongThingErr :: String -> TcTyThing -> Name -> TcM a
 wrongThingErr expected thing name
   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
 		ptext (sLit "used as a") <+> text expected)
-- 
1.7.10.4