diff options
author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-08-06 13:10:03 +0000 |
---|---|---|
committer | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2016-08-06 13:10:30 +0000 |
commit | bd5106441bb91bbadadd2ffd4e9b77bd8f50772c (patch) | |
tree | af74c4f59690ab904b1b04e39b58a840ab258b8b | |
parent | 3bfe6a52783d00d0f7231a2d58c6279c8a580812 (diff) | |
download | haskell-bd5106441bb91bbadadd2ffd4e9b77bd8f50772c.tar.gz |
RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps
-rw-r--r-- | compiler/cmm/BlockId.hs | 8 | ||||
-rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/Spill.hs | 20 | ||||
-rw-r--r-- | compiler/nativeGen/RegAlloc/Graph/SpillClean.hs | 18 | ||||
-rw-r--r-- | compiler/nativeGen/RegAlloc/Liveness.hs | 12 |
4 files changed, 29 insertions, 29 deletions
diff --git a/compiler/cmm/BlockId.hs b/compiler/cmm/BlockId.hs index e4cc0bccb7..ac3af90f2a 100644 --- a/compiler/cmm/BlockId.hs +++ b/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 diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs index a1d46cbc1b..a9ea6e5728 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs +++ b/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' diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs index 25d0ff4e80..1df4b2570a 100644 --- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs +++ b/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 diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index 53cf241413..ea010a52e9 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/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) |