warning police

compiler/nativeGen/GraphBase.hs

 
 -- | 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 }

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

compiler/nativeGen/GraphOps.hs

-
 -- | 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
 		

compiler/nativeGen/GraphPpr.hs

 
 -- | 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 ];"
 

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
    

compiler/nativeGen/RegAllocLinear.hs

-{-# 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

compiler/nativeGen/RegAllocStats.hs

-
 -- 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
 

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

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"

compiler/nativeGen/RegCoalesce.hs

-
 -- | 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))

compiler/nativeGen/RegLiveness.hs

@@ -5,13 +5,7 @@
 -- (c) The University of Glasgow 2004
 --
 -----------------------------------------------------------------------------
-