RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps

compiler/cmm/BlockId.hs

@@ -7,7 +7,7 @@ module BlockId
   , BlockSet, BlockEnv
   , IsSet(..), setInsertList, setDeleteList, setUnions
   , IsMap(..), mapInsertList, mapDeleteList, mapUnions
-  , emptyBlockSet, emptyBlockMap
+  , emptyBlockSet, emptyBlockMap, lookupBlockMap, insertBlockMap
   , blockLbl, infoTblLbl, retPtLbl
   ) where
 
@@ -61,6 +61,12 @@ instance Outputable a => Outputable (BlockEnv a) where
 emptyBlockMap :: BlockEnv a
 emptyBlockMap = mapEmpty
 
+lookupBlockMap :: BlockId -> BlockEnv a -> Maybe a
+lookupBlockMap = mapLookup
+
+insertBlockMap :: BlockId -> a -> BlockEnv a -> BlockEnv a
+insertBlockMap = mapInsert
+
 -- Block sets
 type BlockSet = Hoopl.LabelSet
 

compiler/nativeGen/RegAlloc/Graph/Spill.hs

@@ -24,10 +24,8 @@ import Platform
 
 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.IntSet              (IntSet)
+import qualified Data.IntSet    as IntSet
 
 
 -- | Spill all these virtual regs to stack slots.
@@ -110,7 +108,7 @@ regSpill_top platform regSlotMap cmm
                 -- 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)
+                let liveSlotsOnEntry' :: BlockMap IntSet
                     liveSlotsOnEntry'
                         = mapFoldWithKey patchLiveSlot
                                          liveSlotsOnEntry liveVRegsOnEntry
@@ -131,23 +129,23 @@ regSpill_top platform regSlotMap cmm
         -- in the given slotmap.
         patchLiveSlot
                 :: BlockId -> RegSet
-                -> Map BlockId (Set Int) -> Map BlockId (Set Int)
+                -> BlockMap IntSet -> BlockMap IntSet
 
         patchLiveSlot blockId regsLive slotMap
          = let
                 -- Slots that are already recorded as being live.
-                curSlotsLive    = fromMaybe Set.empty
-                                $ Map.lookup blockId slotMap
+                curSlotsLive    = fromMaybe IntSet.empty
+                                $ lookupBlockMap blockId slotMap
 
-                moreSlotsLive   = Set.fromList
+                moreSlotsLive   = IntSet.fromList
                                 $ catMaybes
                                 $ map (lookupUFM regSlotMap)
                                 $ nonDetEltsUFM regsLive
                     -- See Note [Unique Determinism and code generation]
 
                 slotMap'
-                 = Map.insert blockId (Set.union curSlotsLive moreSlotsLive)
-                              slotMap
+                 = insertBlockMap blockId (IntSet.union curSlotsLive moreSlotsLive)
+                                  slotMap
 
            in   slotMap'
 

compiler/nativeGen/RegAlloc/Graph/SpillClean.hs

@@ -43,10 +43,8 @@ import Platform
 
 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.IntSet              (IntSet)
+import qualified Data.IntSet    as IntSet
 
 
 -- | The identification number of a spill slot.
@@ -309,7 +307,7 @@ cleanTopBackward cmm
 
 cleanBlockBackward
         :: Instruction instr
-        => Map BlockId (Set Int)
+        => BlockMap IntSet
         -> LiveBasicBlock instr
         -> CleanM (LiveBasicBlock instr)
 
@@ -321,7 +319,7 @@ cleanBlockBackward liveSlotsOnEntry (BasicBlock blockId instrs)
 
 cleanBackward
         :: Instruction instr
-        => Map BlockId (Set Int)    -- ^ Slots live on entry to each block
+        => BlockMap IntSet          -- ^ Slots live on entry to each block
         -> UniqSet Int              -- ^ Slots that have been spilled, but not reloaded from
         -> [LiveInstr instr]        -- ^ acc
         -> [LiveInstr instr]        -- ^ Instrs to clean (in forwards order)
@@ -334,7 +332,7 @@ cleanBackward liveSlotsOnEntry noReloads acc lis
 
 cleanBackward'
         :: Instruction instr
-        => Map BlockId (Set Int)
+        => BlockMap IntSet
         -> UniqFM [BlockId]
         -> UniqSet Int
         -> [LiveInstr instr]
@@ -381,14 +379,14 @@ cleanBackward' liveSlotsOnEntry reloadedBy noReloads acc (li : instrs)
         , targets               <- jumpDestsOfInstr instr
         = do
                 let slotsReloadedByTargets
-                        = Set.unions
+                        = IntSet.unions
                         $ catMaybes
-                        $ map (flip Map.lookup liveSlotsOnEntry)
+                        $ map (flip lookupBlockMap liveSlotsOnEntry)
                         $ targets
 
                 let noReloads'
                         = foldl' delOneFromUniqSet noReloads
-                        $ Set.toList slotsReloadedByTargets
+                        $ IntSet.toList slotsReloadedByTargets
 
                 cleanBackward liveSlotsOnEntry noReloads' (li : acc) instrs
 

compiler/nativeGen/RegAlloc/Liveness.hs

@@ -55,9 +55,7 @@ import State
 
 import Data.List
 import Data.Maybe
-import Data.Map                 (Map)
-import Data.Set                 (Set)
-import qualified Data.Map       as Map
+import Data.IntSet              (IntSet)
 
 -----------------------------------------------------------------------------
 type RegSet = UniqSet Reg
@@ -173,7 +171,7 @@ data LiveInfo
                 [BlockId]                 -- entry points (first one is the
                                           -- entry point for the proc).
                 (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
-                (Map BlockId (Set Int))   -- stack slots live on entry to this block
+                (BlockMap IntSet)         -- stack slots live on entry to this block
 
 
 -- | A basic block with liveness information.
@@ -648,7 +646,7 @@ natCmmTopToLive (CmmData i d)
         = CmmData i d
 
 natCmmTopToLive (CmmProc info lbl live (ListGraph []))
-        = CmmProc (LiveInfo info [] Nothing Map.empty) lbl live []
+        = CmmProc (LiveInfo info [] Nothing emptyBlockMap) lbl live []
 
 natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
  = let  first_id        = blockId first
@@ -659,7 +657,7 @@ natCmmTopToLive proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
                                         BasicBlock l (map (\i -> LiveInstr (Instr i) Nothing) instrs)))
                         $ sccs
 
-   in   CmmProc (LiveInfo info (first_id : entry_ids) Nothing Map.empty)
+   in   CmmProc (LiveInfo info (first_id : entry_ids) Nothing emptyBlockMap)
                 lbl live sccsLive
 
 
@@ -725,7 +723,7 @@ regLiveness _ (CmmData i d)
 regLiveness _ (CmmProc info lbl live [])
         | LiveInfo static mFirst _ _    <- info
         = return $ CmmProc
-                        (LiveInfo static mFirst (Just mapEmpty) Map.empty)
+                        (LiveInfo static mFirst (Just mapEmpty) emptyBlockMap)
                         lbl live []
 
 regLiveness platform (CmmProc info lbl live sccs)