Add type sigs to functions in RegAlloc.Graph.Spill

1 files changed, 220 insertions, 201 deletions

diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index e44a65daf5..d8a654a6a5 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -1,12 +1,11 @@
-{-# OPTIONS -fno-warn-missing-signatures #-}
 
 -- | When there aren't enough registers to hold all the vregs we have to spill some of those
 --   vregs to slots on the stack. This module is used modify the code to use those slots.
 --
 module RegAlloc.Graph.Spill (
-	regSpill,
-	SpillStats(..),
-	accSpillSL
+        regSpill,
+        SpillStats(..),
+        accSpillSL
 )
 where
 import RegAlloc.Liveness
@@ -24,14 +23,14 @@ import Outputable
 
 import Data.List
 import Data.Maybe
-import Data.Map			(Map)
-import Data.Set			(Set)
-import qualified Data.Map	as Map
-import qualified Data.Set	as Set
+import Data.Map                 (Map)
+import Data.Set                 (Set)
+import qualified Data.Map       as Map
+import qualified Data.Set       as Set
 
 
 -- | Spill all these virtual regs to stack slots.
--- 
+--
 --   TODO: See if we can split some of the live ranges instead of just globally
 --         spilling the virtual reg. This might make the spill cleaner's job easier.
 --
@@ -40,255 +39,274 @@ import qualified Data.Set	as Set
 --         address the spill slot directly.
 --
 regSpill
-	:: Instruction instr
-	=> [LiveCmmDecl statics instr]	-- ^ the code
-	-> UniqSet Int			-- ^ available stack slots
-	-> UniqSet VirtualReg		-- ^ the regs to spill
-	-> UniqSM
-		([LiveCmmDecl statics instr] -- code with SPILL and RELOAD meta instructions added.
-		, UniqSet Int		    -- left over slots
-		, SpillStats )		    -- stats about what happened during spilling
+        :: Instruction instr
+        => [LiveCmmDecl statics instr]  -- ^ the code
+        -> UniqSet Int                  -- ^ available stack slots
+        -> UniqSet VirtualReg           -- ^ the regs to spill
+        -> UniqSM
+                ([LiveCmmDecl statics instr] -- code with SPILL and RELOAD meta instructions added.
+                , UniqSet Int               -- left over slots
+                , SpillStats )              -- stats about what happened during spilling
 
 regSpill code slotsFree regs
 
-	-- not enough slots to spill these regs
-	| sizeUniqSet slotsFree < sizeUniqSet regs
-	= pprPanic "regSpill: out of spill slots!"
-		(  text "   regs to spill = " <> ppr (sizeUniqSet regs)
-		$$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))
+        -- not enough slots to spill these regs
+        | sizeUniqSet slotsFree < sizeUniqSet regs
+        = pprPanic "regSpill: out of spill slots!"
+                (  text "   regs to spill = " <> ppr (sizeUniqSet regs)
+                $$ text "   slots left    = " <> ppr (sizeUniqSet slotsFree))
 
-	| otherwise
-	= do
-		-- allocate a slot for each of the spilled regs
-		let slots	= take (sizeUniqSet regs) $ uniqSetToList slotsFree
-		let regSlotMap	= listToUFM
-				$ zip (uniqSetToList regs) slots
+        | otherwise
+        = do
+                -- allocate a slot for each of the spilled regs
+                let slots       = take (sizeUniqSet regs) $ uniqSetToList slotsFree
+                let regSlotMap  = listToUFM
+                                $ zip (uniqSetToList regs) slots
 
-		-- grab the unique supply from the monad
-		us	<- getUs
+                -- grab the unique supply from the monad
+                us      <- getUs
 
-		-- run the spiller on all the blocks
-		let (code', state')	=
-			runState (mapM (regSpill_top regSlotMap) code)
-				 (initSpillS us)
+                -- run the spiller on all the blocks
+                let (code', state')     =
+                        runState (mapM (regSpill_top regSlotMap) code)
+                                 (initSpillS us)
 
-		return	( code'
-			, minusUniqSet slotsFree (mkUniqSet slots)
-			, makeSpillStats state')
+                return  ( code'
+                        , minusUniqSet slotsFree (mkUniqSet slots)
+                        , makeSpillStats state')
 
 
 -- | Spill some registers to stack slots in a top-level thing.
-regSpill_top 
-	:: Instruction instr
-	=> RegMap Int 			-- ^ map of vregs to slots they're being spilled to.
-	-> LiveCmmDecl statics instr	-- ^ the top level thing.
-	-> SpillM (LiveCmmDecl statics instr)
-	
+regSpill_top
+        :: Instruction instr
+        => RegMap Int                   -- ^ map of vregs to slots they're being spilled to.
+        -> LiveCmmDecl statics instr    -- ^ the top level thing.
+        -> SpillM (LiveCmmDecl statics instr)
+
 regSpill_top regSlotMap cmm
  = case cmm of
-	CmmData{}				
-	 -> return cmm
-
-	CmmProc info label sccs
-	 |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
-	 -> do	
-		-- We should only passed Cmms with the liveness maps filled in,  but we'll
-		-- create empty ones if they're not there just in case.
-		let liveVRegsOnEntry	= fromMaybe mapEmpty mLiveVRegsOnEntry
-		
-		-- The liveVRegsOnEntry contains the set of vregs that are live on entry to
-		-- each basic block. If we spill one of those vregs we remove it from that
-		-- set and add the corresponding slot number to the liveSlotsOnEntry set.
-		-- The spill cleaner needs this information to erase unneeded spill and 
-		-- reload instructions after we've done a successful allocation.
-		let liveSlotsOnEntry' :: Map BlockId (Set Int)
-		    liveSlotsOnEntry'
-			= mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
-
-		let info'
-			= LiveInfo static firstId
-				(Just liveVRegsOnEntry)
-				liveSlotsOnEntry'
-					
-		-- Apply the spiller to all the basic blocks in the CmmProc.
-		sccs'		<- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
-
-		return	$ CmmProc info' label sccs'
-
- where	-- | Given a BlockId and the set of registers live in it, 
-	--   if registers in this block are being spilled to stack slots, 
-	--   then record the fact that these slots are now live in those blocks
-	--   in the given slotmap.
-	patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
-	patchLiveSlot blockId regsLive slotMap
-	 = let	curSlotsLive	= fromMaybe Set.empty
-				$ Map.lookup blockId slotMap
-
-		moreSlotsLive	= Set.fromList
-				$ catMaybes 
-				$ map (lookupUFM regSlotMap)
-				$ uniqSetToList regsLive
-		
-	  	slotMap'	= Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap
-
-	   in	slotMap'
+        CmmData{}
+         -> return cmm
+
+        CmmProc info label sccs
+         |  LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
+         -> do
+                -- We should only passed Cmms with the liveness maps filled in,  but we'll
+                -- create empty ones if they're not there just in case.
+                let liveVRegsOnEntry    = fromMaybe mapEmpty mLiveVRegsOnEntry
+
+                -- The liveVRegsOnEntry contains the set of vregs that are live on entry to
+                -- each basic block. If we spill one of those vregs we remove it from that
+                -- set and add the corresponding slot number to the liveSlotsOnEntry set.
+                -- The spill cleaner needs this information to erase unneeded spill and
+                -- reload instructions after we've done a successful allocation.
+                let liveSlotsOnEntry' :: Map BlockId (Set Int)
+                    liveSlotsOnEntry'
+                        = mapFoldWithKey patchLiveSlot liveSlotsOnEntry liveVRegsOnEntry
+
+                let info'
+                        = LiveInfo static firstId
+                                (Just liveVRegsOnEntry)
+                                liveSlotsOnEntry'
+
+                -- Apply the spiller to all the basic blocks in the CmmProc.
+                sccs'           <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
+
+                return  $ CmmProc info' label sccs'
+
+ where  -- | Given a BlockId and the set of registers live in it,
+        --   if registers in this block are being spilled to stack slots,
+        --   then record the fact that these slots are now live in those blocks
+        --   in the given slotmap.
+        patchLiveSlot :: BlockId -> RegSet -> Map BlockId (Set Int) -> Map BlockId (Set Int)
+        patchLiveSlot blockId regsLive slotMap
+         = let  curSlotsLive    = fromMaybe Set.empty
+                                $ Map.lookup blockId slotMap
+
+                moreSlotsLive   = Set.fromList
+                                $ catMaybes
+                                $ map (lookupUFM regSlotMap)
+                                $ uniqSetToList regsLive
+
+                slotMap'        = Map.insert blockId (Set.union curSlotsLive moreSlotsLive) slotMap
+
+           in   slotMap'
 
 
 
 -- | Spill some registers to stack slots in a basic block.
 regSpill_block
-	:: Instruction instr
-	=> UniqFM Int		-- ^ map of vregs to slots they're being spilled to.
-	-> LiveBasicBlock instr	
-	-> SpillM (LiveBasicBlock instr)
-	
+        :: Instruction instr
+        => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
+        -> LiveBasicBlock instr
+        -> SpillM (LiveBasicBlock instr)
+
 regSpill_block regSlotMap (BasicBlock i instrs)
- = do	instrss'	<- mapM (regSpill_instr regSlotMap) instrs
- 	return	$ BasicBlock i (concat instrss')
+ = do   instrss'        <- mapM (regSpill_instr regSlotMap) instrs
+        return  $ BasicBlock i (concat instrss')
 
 
 -- | Spill some registers to stack slots in a single instruction.  If the instruction
 --   uses registers that need to be spilled, then it is prefixed (or postfixed) with
 --   the appropriate RELOAD or SPILL meta instructions.
 regSpill_instr
-	:: Instruction instr
-	=> UniqFM Int 		-- ^ map of vregs to slots they're being spilled to.
-	-> LiveInstr instr
-	-> SpillM [LiveInstr instr]
+        :: Instruction instr
+        => UniqFM Int           -- ^ map of vregs to slots they're being spilled to.
+        -> LiveInstr instr
+        -> SpillM [LiveInstr instr]
 
 regSpill_instr _ li@(LiveInstr _ Nothing)
- = do	return [li]
+ = do   return [li]
 
 regSpill_instr regSlotMap
-	(LiveInstr instr (Just _))
+        (LiveInstr instr (Just _))
  = do
-	-- work out which regs are read and written in this instr
-	let RU rlRead rlWritten	= regUsageOfInstr instr
-
-	-- sometimes a register is listed as being read more than once,
-	--	nub this so we don't end up inserting two lots of spill code.
-	let rsRead_		= nub rlRead
-	let rsWritten_		= nub rlWritten
-
-	-- if a reg is modified, it appears in both lists, want to undo this..
-	let rsRead		= rsRead_    \\ rsWritten_
-	let rsWritten		= rsWritten_ \\ rsRead_
-	let rsModify		= intersect rsRead_ rsWritten_
-
-	-- work out if any of the regs being used are currently being spilled.
-	let rsSpillRead		= filter (\r -> elemUFM r regSlotMap) rsRead
-	let rsSpillWritten	= filter (\r -> elemUFM r regSlotMap) rsWritten
-	let rsSpillModify	= filter (\r -> elemUFM r regSlotMap) rsModify
-
-	-- rewrite the instr and work out spill code.
-	(instr1, prepost1)	<- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
-	(instr2, prepost2)	<- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
-	(instr3, prepost3)	<- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
-
-	let (mPrefixes, mPostfixes)	= unzip (prepost1 ++ prepost2 ++ prepost3)
-	let prefixes			= concat mPrefixes
-	let postfixes			= concat mPostfixes
-
-	-- final code
-	let instrs'	=  prefixes
-			++ [LiveInstr instr3 Nothing]
-			++ postfixes
-
-	return
-{-		$ pprTrace "* regSpill_instr spill"
-			(  text "instr  = " <> ppr instr
-			$$ text "read   = " <> ppr rsSpillRead
-			$$ text "write  = " <> ppr rsSpillWritten
-			$$ text "mod    = " <> ppr rsSpillModify
-			$$ text "-- out"
-			$$ (vcat $ map ppr instrs')
-			$$ text " ")
+        -- work out which regs are read and written in this instr
+        let RU rlRead rlWritten = regUsageOfInstr instr
+
+        -- sometimes a register is listed as being read more than once,
+        --      nub this so we don't end up inserting two lots of spill code.
+        let rsRead_             = nub rlRead
+        let rsWritten_          = nub rlWritten
+
+        -- if a reg is modified, it appears in both lists, want to undo this..
+        let rsRead              = rsRead_    \\ rsWritten_
+        let rsWritten           = rsWritten_ \\ rsRead_
+        let rsModify            = intersect rsRead_ rsWritten_
+
+        -- work out if any of the regs being used are currently being spilled.
+        let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
+        let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
+        let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
+
+        -- rewrite the instr and work out spill code.
+        (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
+        (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
+        (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
+
+        let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
+        let prefixes                    = concat mPrefixes
+        let postfixes                   = concat mPostfixes
+
+        -- final code
+        let instrs'     =  prefixes
+                        ++ [LiveInstr instr3 Nothing]
+                        ++ postfixes
+
+        return
+{-              $ pprTrace "* regSpill_instr spill"
+                        (  text "instr  = " <> ppr instr
+                        $$ text "read   = " <> ppr rsSpillRead
+                        $$ text "write  = " <> ppr rsSpillWritten
+                        $$ text "mod    = " <> ppr rsSpillModify
+                        $$ text "-- out"
+                        $$ (vcat $ map ppr instrs')
+                        $$ text " ")
 -}
-		$ instrs'
+                $ instrs'
 
 
+spillRead
+        :: Instruction instr
+        => UniqFM Int
+        -> instr
+        -> Reg
+        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
 spillRead regSlotMap instr reg
-	| Just slot	<- lookupUFM regSlotMap reg
-	= do 	(instr', nReg)	<- patchInstr reg instr
+        | Just slot     <- lookupUFM regSlotMap reg
+        = do    (instr', nReg)  <- patchInstr reg instr
 
-		modify $ \s -> s
-			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
+                modify $ \s -> s
+                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 0, 1) }
 
-	 	return	( instr'
-			, ( [LiveInstr (RELOAD slot nReg) Nothing]
-			  , []) )
+                return  ( instr'
+                        , ( [LiveInstr (RELOAD slot nReg) Nothing]
+                          , []) )
 
-	| otherwise	= panic "RegSpill.spillRead: no slot defined for spilled reg"
+        | otherwise     = panic "RegSpill.spillRead: no slot defined for spilled reg"
 
 
+spillWrite
+        :: Instruction instr
+        => UniqFM Int
+        -> instr
+        -> Reg
+        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
 spillWrite regSlotMap instr reg
-	| Just slot	<- lookupUFM regSlotMap reg
-	= do 	(instr', nReg)	<- patchInstr reg instr
+        | Just slot     <- lookupUFM regSlotMap reg
+        = do    (instr', nReg)  <- patchInstr reg instr
 
-		modify $ \s -> s
-			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
+                modify $ \s -> s
+                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 0) }
 
-	 	return	( instr'
-			, ( []
-			  , [LiveInstr (SPILL nReg slot) Nothing]))
+                return  ( instr'
+                        , ( []
+                          , [LiveInstr (SPILL nReg slot) Nothing]))
 
-	| otherwise	= panic "RegSpill.spillWrite: no slot defined for spilled reg"
+        | otherwise     = panic "RegSpill.spillWrite: no slot defined for spilled reg"
 
 
+spillModify
+        :: Instruction instr
+        => UniqFM Int
+        -> instr
+        -> Reg
+        -> SpillM (instr, ([LiveInstr instr'], [LiveInstr instr']))
 spillModify regSlotMap instr reg
-	| Just slot	<- lookupUFM regSlotMap reg
-	= do	(instr', nReg)	<- patchInstr reg instr
+        | Just slot     <- lookupUFM regSlotMap reg
+        = do    (instr', nReg)  <- patchInstr reg instr
 
-		modify $ \s -> s
-			{ stateSpillSL 	= addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
+                modify $ \s -> s
+                        { stateSpillSL  = addToUFM_C accSpillSL (stateSpillSL s) reg (reg, 1, 1) }
 
-		return	( instr'
-			, ( [LiveInstr (RELOAD slot nReg) Nothing]
-			  , [LiveInstr (SPILL nReg slot) Nothing]))
+                return  ( instr'
+                        , ( [LiveInstr (RELOAD slot nReg) Nothing]
+                          , [LiveInstr (SPILL nReg slot) Nothing]))
 
-	| otherwise	= panic "RegSpill.spillModify: no slot defined for spilled reg"
+        | otherwise     = panic "RegSpill.spillModify: no slot defined for spilled reg"
 
 
 
 -- | Rewrite uses of this virtual reg in an instr to use a different virtual reg
-patchInstr 
-	:: Instruction instr
-	=> Reg -> instr -> SpillM (instr, Reg)
+patchInstr
+        :: Instruction instr
+        => Reg -> instr -> SpillM (instr, Reg)
 
 patchInstr reg instr
- = do	nUnique		<- newUnique
- 	let nReg	= case reg of 
-				RegVirtual vr 	-> RegVirtual (renameVirtualReg nUnique vr)
-				RegReal{}	-> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
-	let instr'	= patchReg1 reg nReg instr
-	return		(instr', nReg)
+ = do   nUnique         <- newUnique
+        let nReg        = case reg of
+                                RegVirtual vr   -> RegVirtual (renameVirtualReg nUnique vr)
+                                RegReal{}       -> panic "RegAlloc.Graph.Spill.patchIntr: not patching real reg"
+        let instr'      = patchReg1 reg nReg instr
+        return          (instr', nReg)
 
-patchReg1 
-	:: Instruction instr
-	=> Reg -> Reg -> instr -> instr
+patchReg1
+        :: Instruction instr
+        => Reg -> Reg -> instr -> instr
 
 patchReg1 old new instr
- = let	patchF r
-		| r == old	= new
-		| otherwise	= r
-   in	patchRegsOfInstr instr patchF
+ = let  patchF r
+                | r == old      = new
+                | otherwise     = r
+   in   patchRegsOfInstr instr patchF
 
 
 -- Spiller monad --------------------------------------------------------------
 data SpillS
-	= SpillS
-	{ -- | unique supply for generating fresh vregs.
-	  stateUS	:: UniqSupply
-	
-	  -- | spilled vreg vs the number of times it was loaded, stored 
-	, stateSpillSL	:: UniqFM (Reg, Int, Int) }
+        = SpillS
+        { -- | unique supply for generating fresh vregs.
+          stateUS       :: UniqSupply
+
+          -- | spilled vreg vs the number of times it was loaded, stored
+        , stateSpillSL  :: UniqFM (Reg, Int, Int) }
 
+initSpillS :: UniqSupply -> SpillS
 initSpillS uniqueSupply
-	= SpillS
-	{ stateUS	= uniqueSupply
-	, stateSpillSL	= emptyUFM }
+        = SpillS
+        { stateUS       = uniqueSupply
+        , stateSpillSL  = emptyUFM }
 
-type SpillM a	= State SpillS a
+type SpillM a   = State SpillS a
 
 newUnique :: SpillM Unique
 newUnique
@@ -298,22 +316,23 @@ newUnique
           -> do modify $ \s -> s { stateUS = us' }
                 return uniq
 
+accSpillSL :: (Reg, Int, Int) -> (Reg, Int, Int) -> (Reg, Int, Int)
 accSpillSL (r1, s1, l1) (_, s2, l2)
-	= (r1, s1 + s2, l1 + l2)
+        = (r1, s1 + s2, l1 + l2)
 
 
 -- Spiller stats --------------------------------------------------------------
 data SpillStats
-	= SpillStats
-	{ spillStoreLoad	:: UniqFM (Reg, Int, Int) }
+        = SpillStats
+        { spillStoreLoad        :: UniqFM (Reg, Int, Int) }
 
 makeSpillStats :: SpillS -> SpillStats
 makeSpillStats s
-	= SpillStats
-	{ spillStoreLoad	= stateSpillSL s }
+        = SpillStats
+        { spillStoreLoad        = stateSpillSL s }
 
 instance Outputable SpillStats where
  ppr stats
- 	= (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
-			$ eltsUFM (spillStoreLoad stats))
+        = (vcat $ map (\(r, s, l) -> ppr r <+> int s <+> int l)
+                        $ eltsUFM (spillStoreLoad stats))