summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
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
commitbd5106441bb91bbadadd2ffd4e9b77bd8f50772c (patch)
treeaf74c4f59690ab904b1b04e39b58a840ab258b8b
parent3bfe6a52783d00d0f7231a2d58c6279c8a580812 (diff)
downloadhaskell-bd5106441bb91bbadadd2ffd4e9b77bd8f50772c.tar.gz
RegAlloc: Use IntSet/IntMaps instead of generic Set/Maps
-rw-r--r--compiler/cmm/BlockId.hs8
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Spill.hs20
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillClean.hs18
-rw-r--r--compiler/nativeGen/RegAlloc/Liveness.hs12
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)