X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FRegLiveness.hs;h=737ce5a21aee6fa80ae9480fa7c2ecc13fa9e516;hb=b8c0cca3b6d0203144bf4ef213be4597ce86eb33;hp=8f313aeb50678fb228e7b34631f390c38b811b82;hpb=0168c633a9d209e978528f059193d19cdb5e6740;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/RegLiveness.hs b/compiler/nativeGen/RegLiveness.hs
index 8f313ae..737ce5a 100644
--- a/compiler/nativeGen/RegLiveness.hs
+++ b/compiler/nativeGen/RegLiveness.hs
@@ -6,6 +6,12 @@
 --
 -----------------------------------------------------------------------------
 
+{-# OPTIONS_GHC -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/WorkingConventions#Warnings
+-- for details
 
 module RegLiveness (
 	RegSet,
@@ -178,9 +184,6 @@ mapGenBlockTopM f (CmmProc header label params blocks)
  	return	$ CmmProc header label params blocks'
 
 
-
-
-
 -- | Slurp out the list of register conflicts from this top level thing.
 
 slurpConflicts :: LiveCmmTop -> Bag (UniqSet Reg)
@@ -248,22 +251,25 @@ spillNatBlock :: NatBasicBlock -> NatBasicBlock
 spillNatBlock (BasicBlock i instrs)
  = 	BasicBlock i instrs'
  where 	(instrs', _)
- 		= runState (mapM spillNat instrs) 0
+ 		= runState (spillNat [] instrs) 0
+
+	spillNat acc []
+	 = 	return (reverse acc)
 
-	spillNat instr@(DELTA i)
+	spillNat acc (instr@(DELTA i) : instrs)
 	 = do	put i
-	 	return instr
+	 	spillNat acc instrs
 
-	spillNat (SPILL reg slot)
+	spillNat acc (SPILL reg slot : instrs)
 	 = do	delta	<- get
-	 	return	$ mkSpillInstr reg delta slot
+	 	spillNat (mkSpillInstr reg delta slot : acc) instrs
 
-	spillNat (RELOAD slot reg)
+	spillNat acc (RELOAD slot reg : instrs)
 	 = do	delta	<- get
-	 	return	$ mkLoadInstr reg delta slot
+	 	spillNat (mkLoadInstr reg delta slot : acc) instrs
 
-	spillNat instr
-	 =	return instr
+	spillNat acc (instr : instrs)
+	 =	spillNat (instr : acc) instrs
 
 
 -- | Slurp out a map of how many times each register was live upon entry to an instruction.