warning police

13 files changed, 133 insertions, 189 deletions

diff --git a/compiler/nativeGen/GraphBase.hs b/compiler/nativeGen/GraphBase.hs
index 5b0971d3be..c4e9eb3531 100644
--- a/compiler/nativeGen/GraphBase.hs
+++ b/compiler/nativeGen/GraphBase.hs
@@ -1,11 +1,5 @@
 
 -- | Types for the general graph colorer.
-{-# 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 GraphBase (
 	Triv,
@@ -52,6 +46,7 @@ data Graph k cls color
 	  graphMap		:: UniqFM (Node k cls color)  }
 
 -- | An empty graph.	
+initGraph :: Graph k cls color
 initGraph
 	= Graph
 	{ graphMap		= emptyUFM }
diff --git a/compiler/nativeGen/GraphColor.hs b/compiler/nativeGen/GraphColor.hs
index ecebf27673..c60c12dae0 100644
--- a/compiler/nativeGen/GraphColor.hs
+++ b/compiler/nativeGen/GraphColor.hs
@@ -3,13 +3,7 @@
 --	This is a generic graph coloring library, abstracted over the type of
 --	the node keys, nodes and colors.
 --
-
-{-# 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
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphColor ( 
 	module GraphBase,
@@ -121,7 +115,7 @@ assignColors
 assignColors colors graph ks 
  	= assignColors' colors graph [] ks
 
- where	assignColors' colors graph prob []
+ where	assignColors' _ graph prob []
 		= (graph, prob)
 
 	assignColors' colors graph prob (k:ks)
@@ -189,12 +183,12 @@ selectColor colors graph u
 
 		-- we got one of our preferences, score!
 		| not $ isEmptyUniqSet colors_ok_pref	
-		, c : rest	<- uniqSetToList colors_ok_pref
+		, c : _		<- uniqSetToList colors_ok_pref
 		= Just c
 		
 		-- it wasn't a preference, but it was still ok
 		| not $ isEmptyUniqSet colors_ok
-		, c : rest	<- uniqSetToList colors_ok
+		, c : _		<- uniqSetToList colors_ok
 		= Just c
 		
 		-- leave this node uncolored
diff --git a/compiler/nativeGen/GraphOps.hs b/compiler/nativeGen/GraphOps.hs
index e61b9d1f96..f620d8a0df 100644
--- a/compiler/nativeGen/GraphOps.hs
+++ b/compiler/nativeGen/GraphOps.hs
@@ -1,13 +1,6 @@
-
 -- | Basic operations on graphs.
 --
-
-{-# 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
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module GraphOps (
 	addNode, 	delNode,	getNode,	lookupNode,	modNode,
@@ -432,7 +425,7 @@ slurpNodeConflictCount
 
 slurpNodeConflictCount graph
 	= addListToUFM_C
-		(\(c1, n1) (c2, n2) -> (c1, n1 + n2))
+		(\(c1, n1) (_, n2) -> (c1, n1 + n2))
 		emptyUFM
 	$ map 	(\node
 	 	  -> let count	= sizeUniqSet $ nodeConflicts node
@@ -461,7 +454,7 @@ adjustWithDefaultUFM
 
 adjustWithDefaultUFM f def k map
 	= addToUFM_C 
-		(\old new -> f old)
+		(\old _ -> f old)
 		map
 		k def
 		
diff --git a/compiler/nativeGen/GraphPpr.hs b/compiler/nativeGen/GraphPpr.hs
index 4f84cbdab1..1df5158dc2 100644
--- a/compiler/nativeGen/GraphPpr.hs
+++ b/compiler/nativeGen/GraphPpr.hs
@@ -1,13 +1,6 @@
 
 -- | Pretty printing of graphs.
 
-{-# 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 GraphPpr (
 	dumpGraph,
 	dotGraph
@@ -34,6 +27,10 @@ dumpGraph graph
 	=  text "Graph"
 	$$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
 	
+dumpNode 
+	:: (Outputable k, Outputable cls, Outputable color)
+	=> Node k cls color -> SDoc
+
 dumpNode node
  	=  text "Node " <> ppr (nodeId node)
 	$$ text "conflicts " 
@@ -76,6 +73,13 @@ dotGraph colorMap triv graph
 		++ [ text "}"
 		   , space ])
 	
+
+dotNode :: ( Uniquable k
+	   , Outputable k, Outputable cls, Outputable color)
+	=> (color -> SDoc)
+	-> Triv k cls color
+	-> Node k cls color -> SDoc
+	
 dotNode colorMap triv node
  = let	name	= ppr $ nodeId node
 	cls	= ppr $ nodeClass node
@@ -126,6 +130,13 @@ dotNode colorMap triv node
 --	conflict if the graphviz graph. Traverse over the graph, but make sure
 --	to only print the edges for each node once.
 
+dotNodeEdges 
+	:: ( Uniquable k
+	   , Outputable k, Outputable cls, Outputable color)
+	=> UniqSet k
+	-> Node k cls color
+	-> (UniqSet k, Maybe SDoc)
+
 dotNodeEdges visited node
 	| elementOfUniqSet (nodeId node) visited
 	= ( visited
@@ -148,9 +159,11 @@ dotNodeEdges visited node
 	  in	( addOneToUniqSet visited (nodeId node)
 		, Just out)
 
-dotEdgeConflict u1 u2
-	= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> text ";"
+	where	dotEdgeConflict u1 u2
+			= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) 
+			<> text ";"
 
-dotEdgeCoalesce u1 u2
-	= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> space <> text "[ style = dashed ];"
+		dotEdgeCoalesce u1 u2
+			= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) 
+			<> space <> text "[ style = dashed ];"
 
diff --git a/compiler/nativeGen/RegAllocColor.hs b/compiler/nativeGen/RegAllocColor.hs
index b9eda1b3ba..2e3d40e427 100644
--- a/compiler/nativeGen/RegAllocColor.hs
+++ b/compiler/nativeGen/RegAllocColor.hs
@@ -12,13 +12,7 @@
 --
 --	Colors in graphviz graphs could be nicer.
 --
-
-{-# 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
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocColor ( 
 	regAlloc,
@@ -67,7 +61,7 @@ regAlloc
 		
 regAlloc dump regsFree slotsFree code
  = do
- 	(code_final, debug_codeGraphs, graph_final)
+ 	(code_final, debug_codeGraphs, _)
 		<- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
 	
 	return	( code_final
@@ -89,7 +83,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
 
 	-- build a map of how many instructions each reg lives for.
 	--	this is lazy, it won't be computed unless we need to spill
-	let fmLife	= plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
+	let fmLife	= plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
 			$ map lifetimeCount code
 
 	-- record startup state
@@ -270,10 +264,10 @@ graphAddCoalesce
 	-> Color.Graph Reg RegClass Reg
 	
 graphAddCoalesce (r1, r2) graph
-	| RealReg regno <- r1
+	| RealReg _ <- r1
 	= Color.addPreference (regWithClass r2) r1 graph
 	
-	| RealReg regno <- r2
+	| RealReg _ <- r2
 	= Color.addPreference (regWithClass r1) r2 graph
 	
 	| otherwise
@@ -306,7 +300,7 @@ patchRegsFromGraph graph code
 		= pprPanic "patchRegsFromGraph: register mapping failed." 
 			(  text "There is no node in the graph for register " <> ppr reg
 			$$ ppr code
-			$$ Color.dotGraph (\x -> text "white") trivColorable graph)
+			$$ Color.dotGraph (\_ -> text "white") trivColorable graph)
 	
    in	patchEraseLive patchF code
    
diff --git a/compiler/nativeGen/RegAllocLinear.hs b/compiler/nativeGen/RegAllocLinear.hs
index bd9b82a187..c3a7319102 100644
--- a/compiler/nativeGen/RegAllocLinear.hs
+++ b/compiler/nativeGen/RegAllocLinear.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
-
 -----------------------------------------------------------------------------
 --
 -- The register allocator
@@ -12,6 +5,7 @@
 -- (c) The University of Glasgow 2004
 --
 -----------------------------------------------------------------------------
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 {-
 The algorithm is roughly:
@@ -111,7 +105,7 @@ import State
 #ifndef DEBUG
 import Data.Maybe	( fromJust )
 #endif
-import Data.List	( nub, partition, mapAccumL, foldl')
+import Data.List	( nub, partition, foldl')
 import Control.Monad	( when )
 import Data.Word
 import Data.Bits
@@ -195,7 +189,7 @@ initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
 
 getFreeRegs :: RegClass -> FreeRegs -> [RegNo]	-- lazilly
 getFreeRegs cls f = go f 0
-  where go 0 m = []
+  where go 0 _ = []
         go n m 
 	  | n .&. 1 /= 0 && regClass (RealReg m) == cls
 	  = m : (go (n `shiftR` 1) $! (m+1))
@@ -228,7 +222,7 @@ emptyStackMap :: StackMap
 emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
 
 getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
-getStackSlotFor fs@(StackMap [] reserved) reg
+getStackSlotFor (StackMap [] _) _
 	= panic "RegAllocLinear.getStackSlotFor: out of stack slots"
 getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
     case lookupUFM reserved reg of
@@ -243,25 +237,25 @@ regAlloc
 	:: LiveCmmTop
 	-> UniqSM (NatCmmTop, Maybe RegAllocStats)
 
-regAlloc cmm@(CmmData sec d) 
+regAlloc (CmmData sec d) 
  	= return
 		( CmmData sec d
 		, Nothing )
 	
-regAlloc cmm@(CmmProc (LiveInfo info _ _) lbl params [])
+regAlloc (CmmProc (LiveInfo info _ _) lbl params [])
 	= return
 		( CmmProc info lbl params []
 		, Nothing )
 	
-regAlloc cmm@(CmmProc static lbl params comps)
+regAlloc (CmmProc static lbl params comps)
 	| LiveInfo info (Just first_id) block_live	<- static
 	= do	
  		-- do register allocation on each component.
 		(final_blocks, stats)
 			<- linearRegAlloc block_live 
 			$ map (\b -> case b of 
-					BasicBlock i [b]	-> AcyclicSCC b
-					BasicBlock i bs		-> CyclicSCC  bs)
+					BasicBlock _ [b]	-> AcyclicSCC b
+					BasicBlock _ bs		-> CyclicSCC  bs)
 			$ comps
 
 		-- make sure the block that was first in the input list
@@ -272,6 +266,9 @@ regAlloc cmm@(CmmProc static lbl params comps)
 		return	( CmmProc info lbl params (first' : rest')
 			, Just stats)
 	
+-- bogus. to make non-exhaustive match warning go away.
+regAlloc (CmmProc _ _ _ _)
+	= panic "RegAllocLinear.regAlloc: no match"
 
 
 -- -----------------------------------------------------------------------------
@@ -310,13 +307,13 @@ linearRegAlloc
 
 linearRegAlloc block_live sccs
  = do	us	<- getUs
- 	let (block_assig', stackMap', stats, blocks) =
+ 	let (_, _, stats, blocks) =
 		runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
 			$ linearRA_SCCs block_live [] sccs
 
 	return	(blocks, stats)
 
-linearRA_SCCs block_live blocksAcc []
+linearRA_SCCs _ blocksAcc []
 	= return $ reverse blocksAcc
 
 linearRA_SCCs block_live blocksAcc (AcyclicSCC block : sccs) 
@@ -370,7 +367,7 @@ linearRA
 	-> [Instr] -> [NatBasicBlock] -> [LiveInstr]
 	-> RegM ([Instr], [NatBasicBlock])
 
-linearRA block_live instr_acc fixups []
+linearRA _          instr_acc fixups []
 	= return (reverse instr_acc, fixups)
 
 linearRA block_live instr_acc fixups (instr:instrs)
@@ -390,10 +387,10 @@ raInsn  :: BlockMap RegSet		-- Live temporaries at each basic block
 	     [NatBasicBlock]		-- extra fixup blocks
 	   )
 
-raInsn block_live new_instrs (Instr instr@(COMMENT _) Nothing)
+raInsn _     new_instrs (Instr (COMMENT _) Nothing)
  = return (new_instrs, [])
 
-raInsn block_live new_instrs (Instr instr@(DELTA n) Nothing)  
+raInsn _     new_instrs (Instr (DELTA n) Nothing)  
  = do
     setDeltaR n
     return (new_instrs, [])
@@ -432,12 +429,12 @@ raInsn block_live new_instrs (Instr instr (Just live))
 	   -}
 	   return (new_instrs, [])
 
-	other -> genRaInsn block_live new_instrs instr 
+	_ -> genRaInsn block_live new_instrs instr 
 			(uniqSetToList $ liveDieRead live) 
 			(uniqSetToList $ liveDieWrite live)
 
 
-raInsn block_live new_instrs li
+raInsn _ _ li
 	= pprPanic "raInsn" (text "no match for:" <> ppr li)
 
 
@@ -527,7 +524,7 @@ releaseRegs regs = do
   free <- getFreeRegsR
   loop assig free regs 
  where
-  loop assig free _ | free `seq` False = undefined
+  loop _     free _ | free `seq` False = undefined
   loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
   loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs
   loop assig free (r:rs) = 
@@ -597,7 +594,7 @@ clobberRegs clobbered = do
   clobber assig ((temp, InBoth reg slot) : rest)
 	| reg `elem` clobbered
 	= clobber (addToUFM assig temp (InMem slot)) rest
-  clobber assig (entry:rest)
+  clobber assig (_:rest)
 	= clobber assig rest 
 
 -- -----------------------------------------------------------------------------
@@ -618,7 +615,7 @@ allocateRegsAndSpill
 	-> [Reg]		-- temps to allocate
 	-> RegM ([Instr], [RegNo])
 
-allocateRegsAndSpill reading keep spills alloc []
+allocateRegsAndSpill _       _    spills alloc []
   = return (spills,reverse alloc)
 
 allocateRegsAndSpill reading keep spills alloc (r:rs) = do
@@ -633,7 +630,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do
   -- InReg, because the memory value is no longer valid.
   -- NB2. This is why we must process written registers here, even if they
   -- are also read by the same instruction.
-     Just (InBoth my_reg mem) -> do
+     Just (InBoth my_reg _) -> do
 	when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
    	allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
 
@@ -734,7 +731,7 @@ loadTemp _ _ _ _ spills =
 
 
 myHead s [] = panic s
-myHead s (x:xs) = x
+myHead _ (x:_) = x
 
 -- -----------------------------------------------------------------------------
 -- Joining a jump instruction to its targets
@@ -753,7 +750,7 @@ joinToTargets
 	-> [BlockId]
 	-> RegM ([NatBasicBlock], Instr)
 
-joinToTargets block_live new_blocks instr []
+joinToTargets _          new_blocks instr []
   = return (new_blocks, instr)
 
 joinToTargets block_live new_blocks instr (dest:dests) = do
@@ -787,7 +784,7 @@ joinToTargets block_live new_blocks instr (dest:dests) = do
 				(freeregs',adjusted_assig))
 	  joinToTargets block_live new_blocks instr dests
 
-	Just (freeregs,dest_assig)
+	Just (_, dest_assig)
 
 	   -- the assignments match
 	   | ufmToList dest_assig == ufmToList adjusted_assig
@@ -852,13 +849,13 @@ expandNode vreg loc@(InMem src) (InBoth dst mem)
 	| src == mem = [(vreg, loc, [InReg dst])]
 	| otherwise  = [(vreg, loc, [InReg dst, InMem mem])]
 
-expandNode vreg loc@(InBoth _ src) (InMem dst)
+expandNode _        (InBoth _ src) (InMem dst)
 	| src == dst = [] -- guaranteed to be true
 
-expandNode vreg loc@(InBoth src _) (InReg dst)
+expandNode _        (InBoth src _) (InReg dst)
 	| src == dst = []
 
-expandNode vreg loc@(InBoth src _) dst
+expandNode vreg     (InBoth src _) dst
 	= expandNode vreg (InReg src) dst
 
 expandNode vreg src dst
@@ -870,7 +867,7 @@ expandNode vreg src dst
 --	can join together allocations for different basic blocks.
 --
 makeMove :: Int -> Unique -> Loc -> Loc -> RegM Instr
-makeMove delta vreg (InReg src) (InReg dst)
+makeMove _     vreg (InReg src) (InReg dst)
  = do	recordSpill (SpillJoinRR vreg)
  	return	$ mkRegRegMoveInstr (RealReg src) (RealReg dst)
 
@@ -882,7 +879,7 @@ makeMove delta vreg (InReg src) (InMem dst)
  = do	recordSpill (SpillJoinRM vreg)
 	return	$ mkSpillInstr (RealReg src) delta dst
 
-makeMove delta vreg src dst
+makeMove _     vreg src dst
 	= panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
 		++ show dst ++ ")"
 		++ " (workaround: use -fviaC)"
@@ -891,7 +888,7 @@ makeMove delta vreg src dst
 -- we have eliminated any possibility of single-node cylces
 -- in expandNode above.
 handleComponent :: Int -> Instr -> SCC (Unique, Loc, [Loc]) -> RegM [Instr]
-handleComponent delta instr (AcyclicSCC (vreg,src,dsts))
+handleComponent delta _  (AcyclicSCC (vreg,src,dsts))
 	 = mapM (makeMove delta vreg src) dsts
 
 -- we can not have cycles that involve memory
@@ -899,10 +896,10 @@ handleComponent delta instr (AcyclicSCC (vreg,src,dsts))
 -- because memory locations (stack slots) are
 -- allocated exclusively for a virtual register and
 -- therefore can not require a fixup
-handleComponent delta instr (CyclicSCC ((vreg,src@(InReg sreg),dsts):rest))
+handleComponent delta instr (CyclicSCC ((vreg, (InReg sreg),dsts):rest))
  = do
 	spill_id <- getUniqueR
-	(saveInstr,slot) 	<- spillR (RealReg sreg) spill_id
+	(_, slot) 		<- spillR (RealReg sreg) spill_id
 	remainingFixUps 	<- mapM (handleComponent delta instr) (stronglyConnCompR rest)
 	restoreAndFixInstr 	<- getRestoreMoves dsts slot
 	return ([instr] ++ concat remainingFixUps ++ restoreAndFixInstr)
@@ -921,7 +918,7 @@ handleComponent delta instr (CyclicSCC ((vreg,src@(InReg sreg),dsts):rest))
 	getRestoreMoves _ _ 		= panic "getRestoreMoves unknown case"
 
 
-handleComponent delta instr (CyclicSCC _)
+handleComponent _ _ (CyclicSCC _)
  = panic "Register Allocator: handleComponent cyclic"
 
 
@@ -963,7 +960,7 @@ runR block_assig freeregs assig stack us thing =
   case unReg thing (RA_State{ ra_blockassig=block_assig, ra_freeregs=freeregs,
 			ra_assig=assig, ra_delta=0{-???-}, ra_stack=stack,
 			ra_us = us, ra_spills = [] }) of
-	(# state'@RA_State{ ra_blockassig=block_assig, ra_stack=stack', ra_spills=spills' }, returned_thing #)
+	(# state'@RA_State{ ra_blockassig=block_assig, ra_stack=stack' }, returned_thing #)
 		-> (block_assig, stack', makeRAStats state', returned_thing)
 
 spillR :: Reg -> Unique -> RegM (Instr, Int)
@@ -1067,8 +1064,8 @@ countRegRegMovesNat :: NatCmmTop -> Int
 countRegRegMovesNat cmm
 	= execState (mapGenBlockTopM countBlock cmm) 0
  where
- 	countBlock b@(BasicBlock i instrs)
-	 = do	instrs'	<- mapM countInstr instrs
+ 	countBlock b@(BasicBlock _ instrs)
+	 = do	mapM_ countInstr instrs
 	 	return	b
 
 	countInstr instr
diff --git a/compiler/nativeGen/RegAllocStats.hs b/compiler/nativeGen/RegAllocStats.hs
index fca3bfd0b0..728225abb9 100644
--- a/compiler/nativeGen/RegAllocStats.hs
+++ b/compiler/nativeGen/RegAllocStats.hs
@@ -1,13 +1,7 @@
-
 -- Carries interesting info for debugging / profiling of the 
 --	graph coloring register allocator.
-
-{-# 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
+--
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegAllocStats (
 	RegAllocStats (..),
@@ -178,7 +172,7 @@ binLifetimeCount fm
 		$ eltsUFM fm
 
    in	addListToUFM_C
-		(\(l1, c1) (l2, c2) -> (l1, c1 + c2))
+		(\(l1, c1) (_, c2) -> (l1, c1 + c2))
 		emptyUFM
 		lifes
 
@@ -188,7 +182,7 @@ pprStatsConflict
 	:: [RegAllocStats] -> SDoc
 
 pprStatsConflict stats
- = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
+ = let	confMap	= foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
 			emptyUFM
 		$ map Color.slurpNodeConflictCount
 			[ raGraph s | s@RegAllocStatsStart{} <- stats ]
@@ -239,12 +233,12 @@ countSRM_block (BasicBlock i instrs)
  = do	instrs'	<- mapM countSRM_instr instrs
  	return	$ BasicBlock i instrs'
 
-countSRM_instr li@(Instr instr live)
-	| SPILL reg slot	<- instr
+countSRM_instr li@(Instr instr _)
+	| SPILL _ _	<- instr
 	= do	modify 	$ \(s, r, m)	-> (s + 1, r, m)
 		return li
 
-	| RELOAD slot reg	<- instr
+	| RELOAD _ _	<- instr
 	= do	modify	$ \(s, r, m)	-> (s, r + 1, m)
 		return li
 
diff --git a/compiler/nativeGen/RegArchBase.hs b/compiler/nativeGen/RegArchBase.hs
index f8512eb5e2..4709b4caa9 100644
--- a/compiler/nativeGen/RegArchBase.hs
+++ b/compiler/nativeGen/RegArchBase.hs
@@ -12,13 +12,6 @@
 --	This code is here because we can test the architecture specific code against it.
 --
 
-{-# 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 RegArchBase (
 	RegClass(..),
 	Reg(..),
@@ -71,7 +64,7 @@ instance Uniquable Reg where
 	 = mkUnique 'S'
 	 $ fromEnum s * 10000 + fromEnum c * 1000 + i
 
-	getUnique (RegSub s (RegSub c _))
+	getUnique (RegSub _ (RegSub _ _))
 	  = error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
 
 -- | A subcomponent of another register
diff --git a/compiler/nativeGen/RegArchX86.hs b/compiler/nativeGen/RegArchX86.hs
index d05538e499..c6c3050a64 100644
--- a/compiler/nativeGen/RegArchX86.hs
+++ b/compiler/nativeGen/RegArchX86.hs
@@ -6,13 +6,6 @@
 --	See MachRegs.hs for the actual trivColorable function used in GHC.
 --
 
-{-# 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 RegArchX86 (
 	classOfReg,
 	regsOfClass,
@@ -30,11 +23,11 @@ import UniqSet
 classOfReg :: Reg -> RegClass
 classOfReg reg
  = case reg of
-	Reg c i		-> c
+	Reg c _		-> c
 	
-	RegSub SubL16 r	-> ClassG16
-	RegSub SubL8  r	-> ClassG8
-	RegSub SubL8H r	-> ClassG8
+	RegSub SubL16 _	-> ClassG16
+	RegSub SubL8  _	-> ClassG8
+	RegSub SubL8H _	-> ClassG8
 
 	
 -- | Determine all the regs that make up a certain class.
@@ -96,18 +89,18 @@ regAlias reg
 	
 	
 	-- 16 bit subregs alias the whole reg
-	RegSub SubL16 r@(Reg ClassG32 i)	
+	RegSub SubL16 r@(Reg ClassG32 _)	
 	 -> 	regAlias r
 	
 	-- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
-	RegSub SubL8  r@(Reg ClassG32 i)
+	RegSub SubL8  r@(Reg ClassG32 _)
 	 -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8 r ]
 
-	RegSub SubL8H r@(Reg ClassG32 i)
+	RegSub SubL8H r@(Reg ClassG32 _)
 	 -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8H r ]
 	
 	-- fp
-	Reg ClassF64 i	
+	Reg ClassF64 _	
 	 -> unitUniqSet reg
 
 	_ -> error "regAlias: invalid register"
diff --git a/compiler/nativeGen/RegCoalesce.hs b/compiler/nativeGen/RegCoalesce.hs
index 76cd6724fc..2bcc6eca56 100644
--- a/compiler/nativeGen/RegCoalesce.hs
+++ b/compiler/nativeGen/RegCoalesce.hs
@@ -1,14 +1,6 @@
-
 -- | Register coalescing.
 --
 
-{-# 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 RegCoalesce (
 	regCoalesce,
 	slurpJoinMovs
@@ -71,8 +63,8 @@ slurpJoinMovs live
  where	
   	slurpCmm   rs  CmmData{}		= rs
 	slurpCmm   rs (CmmProc _ _ _ blocks)	= foldl' slurpComp  rs blocks
-   	slurpComp  rs (BasicBlock i blocks)	= foldl' slurpBlock rs blocks
-	slurpBlock rs (BasicBlock i instrs)	= foldl' slurpLI    rs instrs
+   	slurpComp  rs (BasicBlock _ blocks)	= foldl' slurpBlock rs blocks
+	slurpBlock rs (BasicBlock _ instrs)	= foldl' slurpLI    rs instrs
 		
 	slurpLI    rs (Instr _	Nothing)	= rs
 	slurpLI    rs (Instr instr (Just live))
diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index f2db089882..c47ce96006 100644
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -5,13 +5,7 @@
 -- (c) The University of Glasgow 2004
 --
 -----------------------------------------------------------------------------
-
-{-# 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
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegLiveness (
 	RegSet,
@@ -60,9 +54,13 @@ import Data.Maybe
 type RegSet = UniqSet Reg
 
 type RegMap a = UniqFM a
+
+emptyRegMap :: UniqFM a
 emptyRegMap = emptyUFM
 
 type BlockMap a = UniqFM a
+
+emptyBlockMap :: UniqFM a
 emptyBlockMap = emptyUFM
 
 
@@ -149,7 +147,7 @@ mapBlockTopM
 	=> (LiveBasicBlock -> m LiveBasicBlock)
 	-> LiveCmmTop -> m LiveCmmTop
 
-mapBlockTopM f cmm@(CmmData{})
+mapBlockTopM _ cmm@(CmmData{})
 	= return cmm
 
 mapBlockTopM f (CmmProc header label params comps)
@@ -176,7 +174,7 @@ mapGenBlockTopM
 	=> (GenBasicBlock i -> m (GenBasicBlock i))
 	-> (GenCmmTop d h i -> m (GenCmmTop d h i))
 
-mapGenBlockTopM f cmm@(CmmData{})
+mapGenBlockTopM _ cmm@(CmmData{})
 	= return cmm
 
 mapGenBlockTopM f (CmmProc header label params blocks)
@@ -196,7 +194,7 @@ slurpConflicts live
  	slurpCmm   rs (CmmProc info _ _ blocks)	
 		= foldl' (slurpComp info) rs blocks
 
-	slurpComp  info rs (BasicBlock i blocks)	
+	slurpComp  info rs (BasicBlock _ blocks)	
 		= foldl' (slurpBlock info) rs blocks
 
 	slurpBlock info rs (BasicBlock blockId instrs)	
@@ -213,7 +211,7 @@ slurpConflicts live
 
 	slurpLIs rsLive rs (Instr _ Nothing     : lis)	= slurpLIs rsLive rs lis
 		
-	slurpLIs rsLiveEntry (conflicts, moves) (li@(Instr instr (Just live)) : lis)
+	slurpLIs rsLiveEntry (conflicts, moves) (Instr instr (Just live) : lis)
 	 = let
 		-- regs that die because they are read for the last time at the start of an instruction
 		--	are not live across it.
@@ -255,7 +253,7 @@ stripLive live
  	stripCmm (CmmProc (LiveInfo info _ _) label params comps)
 		= CmmProc info label params (concatMap stripComp comps)
 
-	stripComp  (BasicBlock i blocks)	= map stripBlock blocks
+	stripComp  (BasicBlock _ blocks)	= map stripBlock blocks
 	stripBlock (BasicBlock i instrs)	= BasicBlock i (map stripLI instrs)
 	stripLI    (Instr instr _)		= instr
 
@@ -271,7 +269,7 @@ spillNatBlock (BasicBlock i is)
 	spillNat acc []
 	 = 	return (reverse acc)
 
-	spillNat acc (instr@(DELTA i) : instrs)
+	spillNat acc (DELTA i : instrs)
 	 = do	put i
 	 	spillNat acc instrs
 
@@ -300,7 +298,7 @@ lifetimeCount cmm
 	countCmm fm (CmmProc info _ _ blocks)
 		= foldl' (countComp info) fm blocks
 		
-	countComp info fm (BasicBlock i blocks)
+	countComp info fm (BasicBlock _ blocks)
 		= foldl' (countBlock info) fm blocks
 		
  	countBlock info fm (BasicBlock blockId instrs)
@@ -311,7 +309,7 @@ lifetimeCount cmm
 		| otherwise
 		= error "RegLiveness.countBlock: bad block"
 		
-	countLIs rsLive fm []				= fm
+	countLIs _      fm []				= fm
 	countLIs rsLive fm (Instr _ Nothing : lis)	= countLIs rsLive fm lis
 	
 	countLIs rsLiveEntry fm (Instr _ (Just live) : lis)
@@ -357,7 +355,7 @@ patchEraseLive patchF cmm
  where
 	patchCmm cmm@CmmData{}	= cmm
 
-	patchCmm cmm@(CmmProc info label params comps)
+	patchCmm (CmmProc info label params comps)
 	 | LiveInfo static id blockMap	<- info
 	 = let 	patchRegSet set	= mkUniqSet $ map patchF $ uniqSetToList set
 		blockMap'	= mapUFM patchRegSet blockMap
@@ -424,15 +422,15 @@ regLiveness
 	:: NatCmmTop
 	-> UniqSM LiveCmmTop
 
-regLiveness cmm@(CmmData sec d)
-	= returnUs $ CmmData sec d
+regLiveness (CmmData i d)
+	= returnUs $ CmmData i d
 
-regLiveness cmm@(CmmProc info lbl params [])
+regLiveness (CmmProc info lbl params [])
 	= returnUs $ CmmProc
 			(LiveInfo info Nothing emptyUFM)
 			lbl params []
 
-regLiveness cmm@(CmmProc info lbl params blocks@(first:rest))
+regLiveness (CmmProc info lbl params blocks@(first : _))
  = let 	first_id		= blockId first
 	sccs			= sccBlocks blocks
 	(ann_sccs, block_live)	= computeLiveness sccs
@@ -531,7 +529,7 @@ livenessBlock
 	-> NatBasicBlock
 	-> (BlockMap RegSet, LiveBasicBlock)
 
-livenessBlock blockmap block@(BasicBlock block_id instrs)
+livenessBlock blockmap (BasicBlock block_id instrs)
  = let
  	(regsLiveOnEntry, instrs1)
  		= livenessBack emptyUniqSet blockmap [] (reverse instrs)
@@ -550,13 +548,13 @@ livenessForward
 	:: RegSet			-- regs live on this instr
 	-> [LiveInstr] -> [LiveInstr]
 
-livenessForward rsLiveEntry []	= []
+livenessForward _           []	= []
 livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
 	| Nothing		<- mLive
 	= li : livenessForward rsLiveEntry lis
 
-	| Just live		<- mLive
-	, RU read written	<- regUsage instr
+	| Just live	<- mLive
+	, RU _ written	<- regUsage instr
 	= let
 		-- Regs that are written to but weren't live on entry to this instruction
 		--	are recorded as being born here.
@@ -570,6 +568,8 @@ livenessForward rsLiveEntry (li@(Instr instr mLive) : lis)
 	in Instr instr (Just live { liveBorn = rsBorn })
 		: livenessForward rsLiveNext lis
 
+livenessForward _ _ 		= panic "RegLiveness.livenessForward: no match"
+
 
 -- | Calculate liveness going backwards,
 --	filling in when regs die, and what regs are live across each instruction
@@ -581,17 +581,17 @@ livenessBack
 	-> [Instr]			-- instructions
 	-> (RegSet, [LiveInstr])
 
-livenessBack liveregs blockmap done []  = (liveregs, done)
+livenessBack liveregs _        done []  = (liveregs, done)
 
 livenessBack liveregs blockmap acc (instr : instrs)
  = let	(liveregs', instr')	= liveness1 liveregs blockmap instr
    in	livenessBack liveregs' blockmap (instr' : acc) instrs
 
 -- don't bother tagging comments or deltas with liveness
-liveness1 liveregs blockmap (instr@COMMENT{})
+liveness1 liveregs _   (instr@COMMENT{})
 	= (liveregs, Instr instr Nothing)
 
-liveness1 liveregs blockmap (instr@DELTA{})
+liveness1 liveregs _   (instr@DELTA{})
 	= (liveregs, Instr instr Nothing)
 
 liveness1 liveregs blockmap instr
diff --git a/compiler/nativeGen/RegSpill.hs b/compiler/nativeGen/RegSpill.hs
index 9379e6e5c4..0fdb8ce857 100644
--- a/compiler/nativeGen/RegSpill.hs
+++ b/compiler/nativeGen/RegSpill.hs
@@ -1,10 +1,5 @@
 
-{-# 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
+{-# OPTIONS -fno-warn-missing-signatures #-}
 
 module RegSpill (
 	regSpill,
@@ -14,8 +9,6 @@ module RegSpill (
 
 where
 
-#include "HsVersions.h"
-
 import RegLiveness
 import RegAllocInfo
 import MachRegs
@@ -86,7 +79,7 @@ regSpill_instr _	li@(Instr _ Nothing)
  = do	return [li]
 
 regSpill_instr regSlotMap
-	(Instr instr (Just live))
+	(Instr instr (Just _))
  = do
 	-- work out which regs are read and written in this instr
 	let RU rlRead rlWritten	= regUsage instr
@@ -214,7 +207,7 @@ newUnique
 	  	modify $ \s -> s { stateUS = us2 }
 		return uniq
 
-accSpillSL (r1, s1, l1) (r2, s2, l2)
+accSpillSL (r1, s1, l1) (_, s2, l2)
 	= (r1, s1 + s2, l1 + l2)
 
 
diff --git a/compiler/nativeGen/RegSpillClean.hs b/compiler/nativeGen/RegSpillClean.hs
index 0ec802349d..a4be8ed222 100644
--- a/compiler/nativeGen/RegSpillClean.hs
+++ b/compiler/nativeGen/RegSpillClean.hs
@@ -23,13 +23,6 @@
 --	spilling %r1 to a slot makes that slot have the same value as %r1.
 --
 
-{-# 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 RegSpillClean (
 	cleanSpills
 )
@@ -44,7 +37,6 @@ import Cmm
 import UniqSet
 import UniqFM
 import State
-import Outputable
 
 import Data.Maybe
 import Data.List
@@ -125,10 +117,10 @@ cleanReload
 	-> [LiveInstr] 		-- ^ instrs to clean (in backwards order)
 	-> CleanM [LiveInstr]	-- ^ cleaned instrs  (in forward   order)
 
-cleanReload assoc acc []
+cleanReload _ acc []
 	= return acc
 
-cleanReload assoc acc (li@(Instr instr live) : instrs)
+cleanReload assoc acc (li@(Instr instr _) : instrs)
 
 	| SPILL reg slot	<- instr
 	= let	assoc'	= addAssoc reg slot	-- doing the spill makes reg and slot the same value
@@ -153,13 +145,13 @@ cleanReload assoc acc (li@(Instr instr live) : instrs)
 	    in	cleanReload assoc' (li : acc) instrs
 
 	-- on a jump, remember the reg/slot association.
-	| targets		<- jumpDests instr []
+	| targets	<- jumpDests instr []
 	, not $ null targets
 	= do	mapM_ (accJumpValid assoc) targets
 		cleanReload assoc (li : acc) instrs
 
 	-- writing to a reg changes its value.
-	| RU read written	<- regUsage instr
+	| RU _ written	<- regUsage instr
 	= let assoc'	= foldr deleteAAssoc assoc written
 	  in  cleanReload assoc' (li : acc) instrs
 
@@ -175,11 +167,11 @@ cleanSpill
 	-> [LiveInstr]		-- ^ instrs to clean (in forwards order)
 	-> CleanM [LiveInstr]	-- ^ cleaned instrs  (in backwards order)
 
-cleanSpill unused acc []
+cleanSpill _      acc []
 	= return  acc
 
-cleanSpill unused acc (li@(Instr instr live) : instrs)
-	| SPILL reg slot	<- instr
+cleanSpill unused acc (li@(Instr instr _) : instrs)
+	| SPILL _ slot	<- instr
 	= if elementOfUniqSet slot unused
 
 	   -- we can erase this spill because the slot won't be read until after the next one
@@ -193,7 +185,7 @@ cleanSpill unused acc (li@(Instr instr live) : instrs)
 	   	cleanSpill unused' (li : acc) instrs
 
 	-- if we reload from a slot then it's no longer unused
-	| RELOAD slot reg	<- instr
+	| RELOAD slot _		<- instr
 	, unused'		<- delOneFromUniqSet unused slot
 	= cleanSpill unused' (li : acc) instrs
 
@@ -238,6 +230,7 @@ data CleanS
 	, sCleanedSpillsAcc	:: Int
 	, sCleanedReloadsAcc	:: Int }
 
+initCleanS :: CleanS
 initCleanS
 	= CleanS
 	{ sJumpValid		= emptyUFM